[isidorus-cvs] r304 - in branches/new-datamodel/src: json rest_interface unit_tests

23 Jun 2010

Author: lgiessmann
Date: Wed Jun 23 14:00:14 2010
New Revision: 304

Log:
new-datamodel: adapted the json im- and exporter to the new datamodel --> the unit-tests must be changed

Modified:
   branches/new-datamodel/src/json/json_exporter.lisp
   branches/new-datamodel/src/json/json_importer.lisp
   branches/new-datamodel/src/json/json_tmcl.lisp
   branches/new-datamodel/src/json/json_tmcl_validation.lisp
   branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp
   branches/new-datamodel/src/unit_tests/datamodel_test.lisp

Modified: branches/new-datamodel/src/json/json_exporter.lisp
==============================================================================

--- branches/new-datamodel/src/json/json_exporter.lisp	(original)
+++ branches/new-datamodel/src/json/json_exporter.lisp	Wed Jun 23 14:00:14 2010
@@ -22,17 +22,22 @@
 ;; =============================================================================
 ;; --- main json data model ----------------------------------------------------
 ;; =============================================================================
-(defgeneric to-json-string (instance &key xtm-id)
+(defgeneric to-json-string (instance &key xtm-id revision)
   (:documentation "converts the Topic Map construct instance to a json string"))
 
 
-(defun identifiers-to-json-string (parent-construct &key (what 'd:psis))
+(defun identifiers-to-json-string (parent-construct &key (what 'd:psis)
+				   (revision *TM-REVISION*))
   "returns the identifiers of a TopicMapConstructC as a json list"
+  (declare (TopicMapConstructC parent-construct)
+	   (symbol what)
+	   (type (or integer null) revision))
   (when (and parent-construct
-	     (or (eql what 'psis) (eql what 'item-identifiers) (eql what 'locators)))
+	     (or (eql what 'psis)
+		 (eql what 'item-identifiers)
+		 (eql what 'locators)))
     (let ((items 
-	   (map 'list #'uri (funcall what parent-construct))))
-      (declare (TopicMapConstructC parent-construct)) ;must be a topic for psis and locators
+	   (map 'list #'uri (funcall what parent-construct :revision revision))))
       (json:encode-json-to-string items))))
 
 
@@ -40,52 +45,66 @@
   "returns a resourceRef and resourceData json object"
   ;(declare (string value datatype))
   (if (string= datatype "http://www.w3.org/2001/XMLSchema#anyURI")
-      (concatenate 'string "\"resourceRef\":"		   
-		   (let ((inner-value
-			  (let ((ref-topic (when (and (> (length value) 0)
-						      (eql (elt value 0) #\#))
-					     (get-item-by-id (subseq value 1) :xtm-id xtm-id))))
-			    (if ref-topic
-				(concatenate 'string "#" (topic-id ref-topic))
-				value))))
-		           (json:encode-json-to-string inner-value))
-		           ",\"resourceData\":null")
+      (concatenate
+       'string "\"resourceRef\":"		   
+       (let ((inner-value
+	      (let ((ref-topic (when (and (> (length value) 0)
+					  (eql (elt value 0) #\#))
+				 (get-item-by-id (subseq value 1) :xtm-id xtm-id))))
+		(if ref-topic
+		    (concatenate 'string "#" (topic-id ref-topic))
+		    value))))
+	 (json:encode-json-to-string inner-value))
+       ",\"resourceData\":null")
       (concatenate 'string "\"resourceRef\":null,"
-		           "\"resourceData\":{\"datatype\":"
-			   (json:encode-json-to-string datatype)
-			   ",\"value\":"
-			   (json:encode-json-to-string value) "}")))
+		   "\"resourceData\":{\"datatype\":"
+		   (json:encode-json-to-string datatype)
+		   ",\"value\":"
+		   (json:encode-json-to-string value) "}")))
 
 
-(defun ref-topics-to-json-string (topics)
+(defun ref-topics-to-json-string (topics &key (revision *TM-REVISION*))
   "returns a json string of all psi-uris of the passed topics as a list of lists"
+  (declare (list topics)
+	   (type (or integer null) revision))
   (if topics
       (let ((psis (json:encode-json-to-string
 		   (map 'list #'(lambda(topic)
 				  (declare (topicC topic))
-				  (map 'list #'uri (psis topic)))
+				  (map 'list #'uri (psis topic :revision revision)))
 			topics))))
 	(declare (list topics))
 	psis)
       "null"))
 
 
-(defun type-to-json-string (parent-elem)
+(defun type-to-json-string (parent-elem &key (revision *TM-REVISION*))
   "returns a json string of the type of the passed parent-elem"
-  (declare (TypableC parent-elem))
-  (concatenate 'string "\"type\":"
-	       (if (slot-boundp parent-elem 'instance-of)
-		   (json:encode-json-to-string (map 'list #'uri (psis (instance-of parent-elem))))
-		   "null")))
+  (declare (TypableC parent-elem)
+	   (type (or integer null) revision))
+  (concatenate
+   'string "\"type\":"
+   (if (instance-of parent-elem :revision revision)
+       (json:encode-json-to-string
+	(map 'list #'uri (psis (instance-of parent-elem :revision revision))))
+       "null")))
 
 
-(defmethod to-json-string ((instance VariantC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance VariantC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms a VariantC object to a json string"
+  (declare (type (or string null) xtm-id)
+	   (type (or integer null) revision))
   (let ((itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string instance :what 'item-identifiers)))
+	 (concatenate
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string instance :what 'item-identifiers
+				      :revision revision)))
 	(scope
-	 (concatenate 'string "\"scopes\":" (ref-topics-to-json-string (themes instance))))
+	 (concatenate
+	  'string "\"scopes\":" (ref-topics-to-json-string
+				 (themes instance :revision revision)
+				 :revision revision)))
 	(resourceX
 	 (let ((value
 		(when (slot-boundp instance 'charvalue)
@@ -97,42 +116,65 @@
     (concatenate 'string "{" itemIdentity "," scope "," resourceX "}")))
 
 
-(defmethod to-json-string ((instance NameC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance NameC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms a NameC object to a json string"
+  (declare (type (or string null) xtm-id)
+	   (type (or integer null) revision))
   (let ((itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string instance :what 'item-identifiers)))
+	 (concatenate
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string instance :what 'item-identifiers
+				      :revision revision)))
 	(type
-	 (type-to-json-string instance))
+	 (type-to-json-string instance :revision revision))
 	(scope
-	 (concatenate 'string "\"scopes\":" (ref-topics-to-json-string (themes instance))))
+	 (concatenate 
+	  'string "\"scopes\":"
+	  (ref-topics-to-json-string (themes instance :revision revision)
+				     :revision revision)))
 	(value
 	 (concatenate 'string "\"value\":"
 		      (if (slot-boundp instance 'charvalue)
 			  (json:encode-json-to-string (charvalue instance))
 			  "null")))
 	(variant
-	 (if (variants instance)
-	     (concatenate 'string "\"variants\":"
-			  (let ((j-variants "["))
-			    (loop for variant in (variants instance)
-			       do (setf j-variants
-					(concatenate 'string j-variants
-						     (json-exporter::to-json-string variant :xtm-id xtm-id) ",")))
-			    (concatenate 'string (subseq j-variants 0 (- (length j-variants) 1)) "]")))
+	 (if (variants instance :revision revision)
+	     (concatenate
+	      'string "\"variants\":"
+	      (let ((j-variants "["))
+		(loop for variant in (variants instance :revision revision)
+		   do (setf j-variants
+			    (concatenate
+			     'string j-variants
+			     (json-exporter::to-json-string variant :xtm-id xtm-id
+							    :revision revision)
+			     ",")))
+			    (concatenate
+			     'string (subseq j-variants 0
+					     (- (length j-variants) 1)) "]")))
 	     (concatenate 'string "\"variants\":null"))))
-    (concatenate 'string "{" itemIdentity "," type "," scope "," value "," variant "}")))
+    (concatenate 'string "{" itemIdentity "," type "," scope "," value
+		 "," variant "}")))
 
 
-(defmethod to-json-string ((instance OccurrenceC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance OccurrenceC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms an OccurrenceC object to a json string"
+  (declare (type (or string null) xtm-id)
+	   (type (or integer null) revision))
   (let ((itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string instance :what 'item-identifiers)))
+	 (concatenate
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string instance :what 'item-identifiers
+				      :revision revision)))
 	(type
-	 (type-to-json-string instance))
+	 (type-to-json-string instance :revision revision))
 	(scope
-	 (concatenate 'string "\"scopes\":" (ref-topics-to-json-string (themes instance))))
+	 (concatenate
+	  'string "\"scopes\":"
+	  (ref-topics-to-json-string (themes instance :revision revision)
+				     :revision revision)))
 	(resourceX
 	 (let ((value
 		(when (slot-boundp instance 'charvalue)
@@ -144,210 +186,298 @@
     (concatenate 'string "{" itemIdentity "," type "," scope "," resourceX "}")))
 
 
-(defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms an TopicC object to a json string"
+  (declare (type (or string null) xtm-id)
+	   (type (or integer null) revision))
   (let ((id
-	 (concatenate 'string "\"id\":" (json:encode-json-to-string (topic-id instance))))
+	 (concatenate
+	  'string "\"id\":"
+	  (json:encode-json-to-string (topic-id instance :revision revision))))
 	(itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string instance :what 'item-identifiers)))
+	 (concatenate
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string instance :what 'item-identifiers
+				      :revision revision)))
 	(subjectLocator 
-	 (concatenate 'string "\"subjectLocators\":"
-		      (identifiers-to-json-string instance :what 'locators)))
+	 (concatenate
+	  'string "\"subjectLocators\":"
+	  (identifiers-to-json-string instance :what 'locators
+				      :revision revision)))
 	(subjectIdentifier
-	 (concatenate 'string "\"subjectIdentifiers\":"
-		      (identifiers-to-json-string instance :what 'psis)))
+	 (concatenate
+	  'string "\"subjectIdentifiers\":"
+	  (identifiers-to-json-string instance :what 'psis
+				      :revision revision)))
 	(instanceOf
-	 (concatenate 'string "\"instanceOfs\":" (ref-topics-to-json-string (list-instanceOf instance))))
+	 (concatenate
+	  'string "\"instanceOfs\":"
+	  (ref-topics-to-json-string (list-instanceOf instance :revision revision)
+				     :revision revision)))
 	(name
-	 (concatenate 'string "\"names\":"
-		      (if (names instance)
-			  (let ((j-names "["))
-			    (loop for item in (names instance)
-			       do (setf j-names
-					(concatenate 'string j-names (to-json-string item :xtm-id xtm-id) ",")))
-			    (concatenate 'string (subseq j-names 0 (- (length j-names) 1)) "]"))
-			  "null")))
+	 (concatenate
+	  'string "\"names\":"
+	  (if (names instance)
+	      (let ((j-names "["))
+		(loop for item in (names instance :revision revision)
+		   do (setf j-names
+			    (concatenate 
+			     'string j-names (to-json-string item :xtm-id xtm-id
+							     :revision revision)
+			     ",")))
+		(concatenate 'string (subseq j-names 0 (- (length j-names) 1)) "]"))
+	      "null")))
 	(occurrence
-	 (concatenate 'string "\"occurrences\":"
-		      (if (occurrences instance)
-			  (let ((j-occurrences "["))
-			    (loop for item in (occurrences instance)
-			       do (setf j-occurrences
-					(concatenate 'string j-occurrences (to-json-string item :xtm-id xtm-id) ",")))
-			    (concatenate 'string (subseq j-occurrences 0 (- (length j-occurrences) 1)) "]"))
-			  "null"))))
-    (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier ","
+	 (concatenate
+	  'string "\"occurrences\":"
+	  (if (occurrences instance)
+	      (let ((j-occurrences "["))
+		(loop for item in (occurrences instance :revision revision)
+		   do (setf j-occurrences
+			    (concatenate
+			     'string j-occurrences
+			     (to-json-string item :xtm-id xtm-id :revision revision)
+			     ",")))
+		(concatenate
+		 'string (subseq j-occurrences 0 (- (length j-occurrences) 1)) "]"))
+	      "null"))))
+    (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," 
+		 subjectIdentifier ","
 		 instanceOf "," name "," occurrence "}")))
 
 
-(defun to-json-topicStub-string (topic)
+(defun to-json-topicStub-string (topic &key (revision *TM-REVISION*))
   "transforms the passed TopicC object to a topic stub
    string in the json format, which contains an id,
    all itemIdentities, all subjectLocators and all
    subjectIdentifiers"
+  (declare (type (or TopicC null) topic)
+	   (type (or integer null) revision))
   (when topic
     (let ((id
-	   (concatenate 'string "\"id\":" (json:encode-json-to-string (topic-id topic))))
+	   (concatenate
+	    'string "\"id\":"
+	    (json:encode-json-to-string (topic-id topic :revision revision))))
 	  (itemIdentity
-	   (concatenate 'string "\"itemIdentities\":"
-			(identifiers-to-json-string topic :what 'item-identifiers)))
+	   (concatenate
+	    'string "\"itemIdentities\":"
+	    (identifiers-to-json-string topic :what 'item-identifiers
+					:revision revision)))
 	  (subjectLocator 
-	   (concatenate 'string "\"subjectLocators\":"
-			(identifiers-to-json-string topic :what 'locators)))
+	   (concatenate
+	    'string "\"subjectLocators\":"
+	    (identifiers-to-json-string topic :what 'locators :revision revision)))
 	  (subjectIdentifier
-	   (concatenate 'string "\"subjectIdentifiers\":"
-			(identifiers-to-json-string topic :what 'psis))))
-      (declare (TopicC topic))
+	   (concatenate
+	    'string "\"subjectIdentifiers\":"
+	    (identifiers-to-json-string topic :what 'psis :revision revision))))
       (concatenate 'string "{" id "," itemIdentity "," subjectLocator ","
 		   subjectIdentifier "}"))))
 
 
-(defmethod to-json-string ((instance RoleC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance RoleC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms an RoleC object to a json string"
-  (declare (ignorable xtm-id))
+  (declare (ignorable xtm-id)
+	   (type (or integer null) revision))
   (let ((itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string instance :what 'item-identifiers)))
+	 (concatenate
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string instance :what 'item-identifiers
+				      :revision revision)))
 	(type
-	 (type-to-json-string instance))
+	 (type-to-json-string instance :revision revision))
 	(topicRef
-	 (concatenate 'string "\"topicRef\":"
-		      (if (slot-boundp instance 'player)
-			  (json:encode-json-to-string (map 'list #'uri (psis (player instance))))
-			  "null"))))
+	 (concatenate
+	  'string "\"topicRef\":"
+	  (if (player instance :revision revision)
+	      (json:encode-json-to-string
+	       (map 'list #'uri (psis (player instance :revision revision)
+				      :revision revision)))
+	      "null"))))
     (concatenate 'string "{" itemIdentity "," type "," topicRef "}")))
 
 
-(defmethod to-json-string ((instance AssociationC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance AssociationC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms an AssociationC object to a json string"
   (let ((itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string instance :what 'item-identifiers)))
+	 (concatenate 
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string instance :what 'item-identifiers
+				      :revision revision)))
 	(type
-	 (type-to-json-string instance))
+	 (type-to-json-string instance :revision revision))
 	(scope
-	 (concatenate 'string "\"scopes\":" (ref-topics-to-json-string (themes instance))))
+	 (concatenate
+	  'string "\"scopes\":"
+	  (ref-topics-to-json-string (themes instance :revision revision)
+				     :revision revision)))
 	(role
-	 (concatenate 'string "\"roles\":"
-		      (if (roles instance)
-			  (let ((j-roles "["))
-			    (loop for item in (roles instance)
-			       do (setf j-roles
-					(concatenate 'string j-roles (to-json-string item :xtm-id xtm-id) ",")))
-			    (concatenate 'string (subseq j-roles 0 (- (length j-roles) 1)) "]"))
-			  "null"))))
+	 (concatenate
+	  'string "\"roles\":"
+	  (if (roles instance :revision revision)
+	      (let ((j-roles "["))
+		(loop for item in (roles instance :revision revision)
+		   do (setf j-roles
+			    (concatenate
+			     'string j-roles (to-json-string item :xtm-id xtm-id
+							     :revision revision)
+			     ",")))
+		(concatenate 'string (subseq j-roles 0 (- (length j-roles) 1)) "]"))
+	      "null"))))
     (concatenate 'string "{" itemIdentity "," type "," scope "," role "}")))
 
 
-(defmethod to-json-string ((instance TopicMapC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance TopicMapC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "returns the ItemIdentifier's uri"
-  (declare (ignorable xtm-id))
-  (let ((ii (item-identifiers instance)))
+  (declare (ignorable xtm-id)
+	   (type (or integer null) revision))
+  (let ((ii (item-identifiers instance :revision revision)))
     (when ii
       (uri (first ii)))))
 
 
-(defmethod to-json-string ((instance FragmentC) &key (xtm-id d:*current-xtm*))
+(defmethod to-json-string ((instance FragmentC) &key (xtm-id d:*current-xtm*)
+			   (revision *TM-REVISION*))
   "transforms an FragmentC object to a json string,
    which contains the main topic, all depending topicStubs
    and all associations depending on the main topic"
+  (declare (type (or string null) xtm-id)
+	   (type (or integer null) revision))
   (let ((main-topic
-	 (concatenate 'string "\"topic\":"
-		      (to-json-string (topic instance) :xtm-id xtm-id)))
+	 (concatenate
+	  'string "\"topic\":"
+	  (to-json-string (topic instance) :xtm-id xtm-id :revision revision)))
 	(topicStubs
-	 (concatenate 'string "\"topicStubs\":"
-		      (if (referenced-topics instance)
-			  (let ((j-topicStubs "["))
-			    (loop for item in (referenced-topics instance)
-			       do (setf j-topicStubs (concatenate 'string j-topicStubs
-								  (to-json-topicStub-string item) ",")))
-			    (concatenate 'string (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]"))
-			  "null")))
+	 (concatenate
+	  'string "\"topicStubs\":"
+	  (if (referenced-topics instance)
+	      (let ((j-topicStubs "["))
+		(loop for item in (referenced-topics instance)
+		   do (setf j-topicStubs
+			    (concatenate
+			     'string j-topicStubs
+			     (to-json-topicStub-string item :revision revision)
+			     ",")))
+		(concatenate
+		 'string (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]"))
+	      "null")))
 	(associations
-	 (concatenate 'string "\"associations\":"
-		      (if (associations instance)
-			  (let ((j-associations "["))
-			    (loop for item in (associations instance)
-			       do (setf j-associations
-					(concatenate 'string j-associations
-						     (to-json-string item :xtm-id xtm-id) ",")))
-			    (concatenate 'string (subseq j-associations 0 (- (length j-associations) 1)) "]"))
-			  "null")))
+	 (concatenate
+	  'string "\"associations\":"
+	  (if (associations instance)
+	      (let ((j-associations "["))
+		(loop for item in (associations instance)
+		   do (setf j-associations
+			    (concatenate 'string j-associations
+					 (to-json-string item :xtm-id xtm-id
+							 :revision revision) ",")))
+		(concatenate 'string (subseq j-associations 0
+					     (- (length j-associations) 1)) "]"))
+	      "null")))
 	(tm-ids
-	 (concatenate 'string "\"tmIds\":"
-		      (if (in-topicmaps (topic instance))
-			  (let ((j-tm-ids "["))
-			    (loop for item in (in-topicmaps (topic instance))
-			       ;do (setf j-tm-ids (concatenate 'string j-tm-ids "\""
-				;			      (d:uri (first (d:item-identifiers item))) "\",")))
-			       do (setf j-tm-ids (concatenate 'string j-tm-ids 
-							      (json:encode-json-to-string (d:uri (first (d:item-identifiers item)))) ",")))
-			    (concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]"))
-			  "null"))))
-    (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}")))
+	 (concatenate
+	  'string "\"tmIds\":"
+	  (if (in-topicmaps (topic instance))
+	      (let ((j-tm-ids "["))
+		(loop for item in (in-topicmaps (topic instance))
+		   do (setf j-tm-ids
+			    (concatenate
+			     'string j-tm-ids 
+			     (json:encode-json-to-string
+			      (d:uri (first (d:item-identifiers item
+								:revision revision))))
+			     ",")))
+		(concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]"))
+	      "null"))))
+    (concatenate 'string "{" main-topic "," topicStubs "," associations
+		 "," tm-ids "}")))
 
 
 ;; =============================================================================
 ;; --- json data summeries -----------------------------------------------------
 ;; =============================================================================
-(defun get-all-topic-psis()
+(defun get-all-topic-psis(&key (revision *TM-REVISION*))
   "returns all topic psis as a json list of the form
    [[topic-1-psi-1, topic-1-psi-2],[topic-2-psi-1, topic-2-psi-2],...]"
+  (declare (type (or integer null) revision))
   (encode-json-to-string
-   (remove-if #'null (map 'list #'(lambda(psi-list)
-				    (when psi-list
-				      (map 'list #'uri psi-list)))
-			  (map 'list #'psis (elephant:get-instances-by-class 'TopicC))))))
+   (remove-if #'null
+	      (map 'list
+		   #'(lambda(psi-list)
+		       (when psi-list
+			 (map 'list #'uri psi-list)))
+		   (map 'list #'psis (get-all-topics revision))))))
 
 
-(defun to-json-string-summary (topic)
+(defun to-json-string-summary (topic &key (revision *TM-REVISION*))
   "creates a json string of called topic element. the following elements are within this
    summary:
     *topic id
     *all identifiers
     *names (only the real name value)
     *occurrences (jonly the resourceRef and resourceData elements)"
-  (declare (TopicC topic))
+  (declare (TopicC topic)
+	   (type (or integer null) revision))
   (let ((id
-	 (concatenate 'string "\"id\":\"" (topic-id topic) "\""))
+	 (concatenate 'string "\"id\":\"" (topic-id topic :revision revision) "\""))
 	(itemIdentity
-	 (concatenate 'string "\"itemIdentities\":"
-		      (identifiers-to-json-string topic :what 'item-identifiers)))
+	 (concatenate
+	  'string "\"itemIdentities\":"
+	  (identifiers-to-json-string topic :what 'item-identifiers
+				      :revision revision)))
 	(subjectLocator 
-	 (concatenate 'string "\"subjectLocators\":"
-		      (identifiers-to-json-string topic :what 'locators)))
+	 (concatenate
+	  'string "\"subjectLocators\":"
+	  (identifiers-to-json-string topic :what 'locators :revision revision)))
 	(subjectIdentifier
-	 (concatenate 'string "\"subjectIdentifiers\":"
-		      (identifiers-to-json-string topic :what 'psis)))
+	 (concatenate
+	  'string "\"subjectIdentifiers\":"
+	  (identifiers-to-json-string topic :what 'psis :revision revision)))
 	(instanceOf
-	 (concatenate 'string "\"instanceOfs\":" (ref-topics-to-json-string (list-instanceOf topic))))
+	 (concatenate
+	  'string "\"instanceOfs\":"
+	  (ref-topics-to-json-string (list-instanceOf topic :revision revision)
+				     :revision revision)))
 	(name
-	 (concatenate 'string "\"names\":"
-		      (if (names topic)
-			  (json:encode-json-to-string (loop for name in (names topic)
-							 when (slot-boundp name 'charvalue)
-							 collect (charvalue name)))
-			  "null")))
+	 (concatenate
+	  'string "\"names\":"
+	  (if (names topic :revision revision)
+	      (json:encode-json-to-string
+	       (loop for name in (names topic :revision revision)
+		  when (slot-boundp name 'charvalue)
+		  collect (charvalue name)))
+	      "null")))
 	(occurrence
-	 (concatenate 'string "\"occurrences\":"
-		      (if (occurrences topic)
-			  (json:encode-json-to-string (loop for occurrence in (occurrences topic)
-							 when (slot-boundp occurrence 'charvalue)
-							 collect (charvalue occurrence)))
-			  "null"))))
-    (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier ","
-		 instanceOf "," name "," occurrence "}")))
+	 (concatenate
+	  'string "\"occurrences\":"
+	  (if (occurrences topic :revision revision)
+	      (json:encode-json-to-string
+	       (loop for occurrence in (occurrences topic :revision revision)
+		  when (slot-boundp occurrence 'charvalue)
+		  collect (charvalue occurrence)))
+	      "null"))))
+    (concatenate 'string "{" id "," itemIdentity "," subjectLocator ","
+		 subjectIdentifier "," instanceOf "," name "," occurrence "}")))
 
 
-(defun make-topic-summary (topic-list)
+(defun make-topic-summary (topic-list &key (revision *TM-REVISION*))
   "creates a json list of the produced json-strings by to-json-string-summary"
+  (declare (list topic-list)
+	   (type (or integer null) revision))
   (if topic-list
       (let ((json-string
 	     (let ((inner-string nil))
-	       (concatenate 'string
-			    (loop for topic in topic-list
-			       do (setf inner-string (concatenate 'string inner-string (to-json-string-summary topic) ","))))
+	       (concatenate
+		'string
+		(loop for topic in topic-list
+		   do (setf inner-string
+			    (concatenate
+			     'string inner-string
+			     (to-json-string-summary topic :revision revision) ","))))
 	       (subseq inner-string 0 (- (length inner-string) 1)))))
 	(concatenate 'string "[" json-string "]"))
       "null"))
\ No newline at end of file

Modified: branches/new-datamodel/src/json/json_importer.lisp
==============================================================================
--- branches/new-datamodel/src/json/json_importer.lisp	(original)
+++ branches/new-datamodel/src/json/json_importer.lisp	Wed Jun 23 14:00:14 2010
@@ -23,11 +23,11 @@
 (defun json-to-elem(json-string &key (xtm-id *json-xtm*))
   "creates all objects (topics, topic stubs, associations)
    of the passed json-decoded-list (=fragment)"
+  (declare (type (or string null) json-string xtm-id))
   (when json-string
     (let ((fragment-values
 	   (get-fragment-values-from-json-list
 	    (json:decode-json-from-string json-string))))
-      (declare (string json-string))
       (let ((topic-values (getf fragment-values :topic))
 	    (topicStubs-values (getf fragment-values :topicStubs))
 	    (associations-values (getf fragment-values :associations))
@@ -38,17 +38,20 @@
 		   (first psi-uris)))))
 	  (elephant:ensure-transaction (:txn-nosync nil) 
 	    (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
-	      (loop for topicStub-values in (append topicStubs-values (list topic-values))
-		 do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
+	      (loop for topicStub-values in
+		   (append topicStubs-values (list topic-values))
+		 do (json-to-stub topicStub-values rev :tm xml-importer::tm
+				  :xtm-id xtm-id))
 	      (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
 	      (loop for association-values in associations-values
-		 do (json-to-association association-values rev :tm xml-importer::tm))))
+		 do (json-to-association association-values rev
+					 :tm xml-importer::tm))))
 	  (when psi-of-topic
 	    (create-latest-fragment-of-topic psi-of-topic)))))))
 
 
 (defun json-to-association (json-decoded-list start-revision
-			    &key tm )
+			    &key tm)
   "creates an association element of the passed json-decoded-list"
   (elephant:ensure-transaction (:txn-nosync t) 
     (let 
@@ -57,9 +60,9 @@
 			 (make-identifier 'ItemIdentifierC uri start-revision))
 	       (getf json-decoded-list :itemIdentities)))
          (instance-of
-          (psis-to-topic (getf json-decoded-list :type)))
+          (psis-to-topic (getf json-decoded-list :type) :revision start-revision))
          (themes
-          (json-to-scope (getf json-decoded-list :scopes)))
+          (json-to-scope (getf json-decoded-list :scopes) start-revision))
          (roles 
           (map 'list #'(lambda(role-values)
 			 (json-to-role role-values start-revision))
@@ -67,7 +70,7 @@
       (declare (list json-decoded-list))
       (declare (integer start-revision))
       (declare (TopicMapC tm))
-      (setf roles (xml-importer::set-standard-role-types roles))
+      (setf roles (xml-importer::set-standard-role-types roles start-revision))
       (add-to-tm tm 
 		       (make-construct 'AssociationC
 				       :start-revision start-revision
@@ -87,14 +90,19 @@
 			 (make-identifier 'ItemIdentifierC uri start-revision))
 	       (getf json-decoded-list :itemIdentities)))
          (instance-of
-          (psis-to-topic (getf json-decoded-list :type)))
+          (psis-to-topic (getf json-decoded-list :type) :revision start-revision))
          (player
-	  (psis-to-topic (getf json-decoded-list :topicRef))))
+	  (psis-to-topic (getf json-decoded-list :topicRef)
+			 :revision start-revision)))
       (declare (list json-decoded-list))
       (declare (integer start-revision))
       (unless player
-        (error "Role in association with topicref ~a not complete" (getf json-decoded-list :topicRef)))
-      (list :instance-of instance-of :player player :item-identifiers item-identifiers)))))
+        (error "Role in association with topicref ~a not complete"
+	       (getf json-decoded-list :topicRef)))
+      (list :instance-of instance-of
+	    :player player
+	    :item-identifiers item-identifiers
+	    :start-revision start-revision)))))
 
 
 (defun json-merge-topic (json-decoded-list start-revision
@@ -113,11 +121,11 @@
 	(declare (TopicMapC tm))
 	(unless top
 	  (error "topic ~a could not be found" (getf json-decoded-list :id)))
-
 	(let ((instanceof-topics
 	       (remove-duplicates
 		(map 'list
-		     #'psis-to-topic
+		     #'(lambda(psis)
+			 (psis-to-topic psis :revision start-revision))
 		     (getf json-decoded-list :instanceOfs)))))
 
 	  (loop for name-values in (getf json-decoded-list :names)
@@ -126,8 +134,9 @@
 	  (loop for occurrence-values in (getf json-decoded-list :occurrences)
 	     do (json-to-occurrence occurrence-values top start-revision))
 	  (dolist (instanceOf-top instanceof-topics)
-	    (json-create-instanceOf-association instanceOf-top top start-revision :tm tm))
-;	  (add-to-tm tm top) ; will be done in "json-to-stub"
+	    (json-create-instanceOf-association instanceOf-top top start-revision
+						:tm tm))
+          ;(add-to-tm tm top) ; will be done in "json-to-stub"
 	  top)))))
 
 
@@ -146,7 +155,11 @@
 	    (subject-locators
 	     (map 'list #'(lambda(uri)
 			    (make-identifier 'SubjectLocatorC uri start-revision))
-		  (getf json-decoded-list :subjectLocators))))
+		  (getf json-decoded-list :subjectLocators)))
+	    (topic-ids
+	     (make-construct 'TopicIdentificationC
+			     :uri (getf json-decoded-list :id)
+			     :xtm-id xtm-id)))
 	;; all topic stubs has to be added top a topicmap object in this method
 	;; becuase the only one topic that is handled in "json-merge-topic"
 	;; is the main topic of the fragment
@@ -155,8 +168,7 @@
 				       :item-identifiers item-identifiers
 				       :locators subject-locators
 				       :psis subject-identifiers
-				       :topicid (getf json-decoded-list :id)
-				       :xtm-id xtm-id)))
+				       :topic-identifiers topic-ids)))
 	  (add-to-tm tm top)
 	  top)))))
 	
@@ -166,13 +178,13 @@
   (when json-decoded-list
     (let
       ((themes
-        (json-to-scope (getf json-decoded-list :scopes)))
+        (json-to-scope (getf json-decoded-list :scopes) start-revision))
        (item-identifiers
 	(map 'list #'(lambda(uri)
 		       (make-identifier 'ItemIdentifierC uri start-revision))
 	     (getf json-decoded-list :itemIdentities)))
        (instance-of 
-        (psis-to-topic (getf json-decoded-list :type)))
+        (psis-to-topic (getf json-decoded-list :type) :revision start-revision))
        (occurrence-value
 	(json-to-resourceX json-decoded-list)))
       
@@ -180,7 +192,7 @@
 	(error "OccurrenceC: one of resourceRef and resourceData must be set"))
       (make-construct 'OccurrenceC 
 		      :start-revision start-revision
-		      :topic top
+		      :parent top
 		      :themes themes
 		      :item-identifiers item-identifiers
 		      :instance-of instance-of
@@ -194,27 +206,30 @@
   (declare (symbol classsymbol))
   (declare (string uri))
   (declare (integer start-revision))
-  (let ((id (make-instance classsymbol
-			   :uri uri
-			   :start-revision start-revision)))
-    id))
+  (make-construct classsymbol
+		  :uri uri
+		  :start-revision start-revision))
 
 
-(defun json-to-scope (json-decoded-list)
+(defun json-to-scope (json-decoded-list start-revision)
   "Generate set of themes (= topics) from this scope element and
    return that set. If the input is nil, the list of themes is empty"
   (when json-decoded-list
     (let ((tops
-	   (map 'list #'psis-to-topic json-decoded-list)))
+	   (map 'list #'(lambda(psis)
+			  (psis-to-topic psis :revision start-revision))
+		json-decoded-list)))
       (declare (list json-decoded-list))
       (unless (>= (length tops) 1)
         (error "need at least one topic in a scope"))
       tops)))
 
 
-(defun psis-to-topic(psis)
+(defun psis-to-topic(psis &key (revision *TM-REVISION*))
   "searches for a topic of the passed psis-list describing
    exactly one topic"
+  (declare (list psis)
+	   (type (or integer null) revision))
   (when psis
     (let ((top
 	   (let ((psi
@@ -223,9 +238,8 @@
 			   'd:PersistentIdC 'd:uri uri)
 		     return (elephant:get-instance-by-value
 			     'd:PersistentIdC 'd:uri uri))))
-	         (format t "psi: ~a~%" psi)
 	     (when psi
-	       (d:identified-construct psi)))))
+	       (d:identified-construct psi :revision revision)))))
       (unless top
 	(error (make-condition 'missing-reference-error
 			       :message (format nil "psis-to-topic: could not resolve reference ~a" psis))))
@@ -241,23 +255,20 @@
 		(getf json-decoded-list :itemIdentities)))
 	  (namevalue (getf json-decoded-list :value))
 	  (themes
-	   (json-to-scope (getf json-decoded-list :scopes)))
+	   (json-to-scope (getf json-decoded-list :scopes) start-revision))
 	  (instance-of
-	   (psis-to-topic (getf json-decoded-list :type))))
-      ;(declare (list json-decoded-list)) causes problems with sbcl 1.0.34.0.debian
-      ;(declare (TopicC top))
+	   (psis-to-topic (getf json-decoded-list :type) :revision start-revision)))
       (unless namevalue
         (error "A name must have exactly one namevalue"))
       (let ((name (make-construct 'NameC 
 				  :start-revision start-revision
-				  :topic top
+				  :parent top
 				  :charvalue namevalue
 				  :instance-of instance-of
 				  :item-identifiers item-identifiers
 				  :themes themes)))
 	(loop for variant in (getf json-decoded-list :variants)
 	   do (json-to-variant variant name start-revision))
-	;(json-to-variant (getf json-decoded-list :variants) name start-revision)
 	name))))
 
 
@@ -269,19 +280,20 @@
 			  (make-identifier 'ItemIdentifierC uri start-revision))
 		(getf json-decoded-list :itemIdentities)))
 	  (themes
-	   (remove-duplicates (append (d:themes name)
-				      (json-to-scope (getf json-decoded-list :scopes)))))
+	   (remove-duplicates
+	    (append (d:themes name)
+		    (json-to-scope (getf json-decoded-list :scopes)
+				   start-revision))))
 	  (variant-value
 	   (json-to-resourceX json-decoded-list)))
       (declare (list json-decoded-list))
-      ;(declare (NameC name))
       (make-construct 'VariantC
 		      :start-revision start-revision
 		      :item-identifiers item-identifiers
 		      :themes themes
 		      :charvalue (getf variant-value :data)
 		      :datatype (getf variant-value :type)
-		      :name name))))
+		      :parent name))))
 
 
 (defun json-to-resourceX(json-decoded-list)
@@ -311,22 +323,18 @@
   from all the others in that it is not modelled one to one, but
   following the suggestion of the XTM 2.0 spec (4.9) and the
   TMDM (7.2) as an association"
-
-  (declare (TopicC supertype))
-  (declare (TopicC player2-obj))
-  (declare (TopicMapC tm))
+  (declare (TopicC supertype player2-obj)
+	   (TopicMapC tm))
   (let
       ((associationtype 
-        (get-item-by-psi constants:*type-instance-psi*))
+        (get-item-by-psi constants:*type-instance-psi* :revision start-revision))
        (roletype1
-        (get-item-by-psi constants:*type-psi*))
+        (get-item-by-psi constants:*type-psi* :revision start-revision))
        (roletype2
-        (get-item-by-psi constants:*instance-psi*))
+        (get-item-by-psi constants:*instance-psi* :revision start-revision))
        (player1 supertype))
-
     (unless (and associationtype roletype1 roletype2)
       (error "Error in the creation of an instanceof association: core topics are missing"))
-
     (add-to-tm 
      tm
      (make-construct 
@@ -335,8 +343,12 @@
       :themes nil
       :start-revision start-revision
       :instance-of associationtype
-      :roles (list (list :instance-of roletype1 :player player1)
-                   (list :instance-of roletype2 :player player2-obj))))))
+      :roles (list (list :instance-of roletype1
+			 :player player1
+			 :start-revision start-revision)
+                   (list :instance-of roletype2
+			 :player player2-obj
+			 :start-revision start-revision))))))
 
 
 (defun get-fragment-values-from-json-list(json-decoded-list)

Modified: branches/new-datamodel/src/json/json_tmcl.lisp
==============================================================================
--- branches/new-datamodel/src/json/json_tmcl.lisp	(original)
+++ branches/new-datamodel/src/json/json_tmcl.lisp	Wed Jun 23 14:00:14 2010
@@ -13,17 +13,23 @@
 ;; =============================================================================
 ;; --- all fragment constraints ------------------------------------------------
 ;; =============================================================================
-(defun get-constraints-of-fragment(topic-psis &key (treat-as 'type))
+(defun get-constraints-of-fragment(topic-psis &key
+				   (treat-as 'type) (revision *TM-REVISION*))
   "Returns a json string with all constraints of this topic-psis.
-   topic-psis must contain one item if it is treated as instance other wiese there can be more psis
-   then the fragment will be treated as an instanceOf all passed psis."
-  (let ((associationtype (get-item-by-psi *associationtype-psi*))
-	(associationtype-constraint (is-type-constrained :what *associationtype-constraint-psi*))
+   topic-psis must contain one item if it is treated as instance otherwise#
+   there can be more psis then the fragment will be treated as an instanceOf
+   all passed psis."
+  (declare (type (or integer null) revision)
+	   (symbol treat-as)
+	   (list topic-psis))
+  (let ((associationtype (get-item-by-psi *associationtype-psi* :revision revision))
+	(associationtype-constraint (is-type-constrained
+				     :what *associationtype-constraint-psi*
+				     :revision revision))
 	(topics nil))
     (when (and (not (eql treat-as 'type))
 	       (> (length topic-psis) 1))
       (error "From get-constraints-of-fragment: when treat-as is set ot instance there must be exactly one item in topic-psis!"))
-
     (loop for topic-psi in topic-psis
        do (let ((psi
 		 (elephant:get-instance-by-value 'PersistentIdC 'uri topic-psi)))
@@ -33,78 +39,110 @@
     (when topics
       (let ((topic-constraints
 	     (let ((value
-		    (get-constraints-of-topic topics :treat-as treat-as)))
+		    (get-constraints-of-topic topics :treat-as treat-as
+					      :revision revision)))
 	       (concatenate 'string "\"topicConstraints\":" value))))
 	(let ((available-associations
 	       (remove-duplicates
 		(loop for topic in topics
-		   append (get-available-associations-of-topic topic :treat-as treat-as)))))
+		   append (get-available-associations-of-topic
+			   topic :treat-as treat-as :revision revision)))))
 	  (dolist (item available-associations)
-	    (topictype-p item associationtype associationtype-constraint))
+	    (topictype-p item associationtype associationtype-constraint
+			 nil revision))
 	  (let ((associations-constraints
-		 (concatenate 'string "\"associationsConstraints\":"
-			      (let ((inner-associations-constraints "["))
-				(loop for available-association in available-associations
-				   do (let ((value
-					     (get-constraints-of-association available-association)))
-					(setf inner-associations-constraints
-					      (concatenate 'string inner-associations-constraints value ","))))
-				(if (string= inner-associations-constraints "[")
-				    (setf inner-associations-constraints "null")
-				    (setf inner-associations-constraints
-					  (concatenate 'string (subseq inner-associations-constraints 0 (- (length inner-associations-constraints) 1)) "]")))))))
+		 (concatenate
+		  'string "\"associationsConstraints\":"
+		  (let ((inner-associations-constraints "["))
+		    (loop for available-association in available-associations
+		       do (let ((value
+				 (get-constraints-of-association
+				  available-association :revision revision)))
+			    (setf inner-associations-constraints
+				  (concatenate 'string inner-associations-constraints
+					       value ","))))
+		    (if (string= inner-associations-constraints "[")
+			(setf inner-associations-constraints "null")
+			(setf inner-associations-constraints
+			      (concatenate
+			       'string
+			       (subseq inner-associations-constraints 0
+				       (- (length inner-associations-constraints) 1))
+			       "]")))))))
 	    (let ((json-string
 		   (concatenate 'string
-				"{" topic-constraints "," associations-constraints "}")))
+				"{" topic-constraints "," associations-constraints
+				"}")))
 	      json-string)))))))
 
 
 ;; =============================================================================
 ;; --- all association constraints ---------------------------------------------
 ;; =============================================================================
-(defun get-constraints-of-association (associationtype-topic)
+(defun get-constraints-of-association (associationtype-topic &key
+				       (revision *TM-REVISION*))
   "Returns a list of constraints which are describing associations of the 
    passed associationtype-topic."
+  (declare (TopicC associationtype-topic)
+	   (type (or integer null) revision))
   (let ((constraint-topics
-	 (get-all-constraint-topics-of-association associationtype-topic)))
+	 (get-all-constraint-topics-of-association associationtype-topic
+						   :revision revision)))
     (let ((associationtype
 	   (concatenate 'string "\"associationType\":"
-			(json-exporter::identifiers-to-json-string associationtype-topic)))
+			(json-exporter::identifiers-to-json-string
+			 associationtype-topic :revision revision)))
 	  (associationtypescope-constraints
-	   (let ((value (get-typescope-constraints associationtype-topic :what 'association)))
+	   (let ((value (get-typescope-constraints associationtype-topic
+						   :what 'association
+						   :revision revision)))
 	     (concatenate 'string "\"scopeConstraints\":" value)))
 	  (associationrole-constraints
 	   (let ((value
-		  (get-associationrole-constraints (getf constraint-topics :associationrole-constraints))))
+		  (get-associationrole-constraints
+		   (getf constraint-topics :associationrole-constraints)
+		   :revision revision)))
 	     (concatenate 'string "\"associationRoleConstraints\":" value)))
 	  (roleplayer-constraints
 	   (let ((value
-		  (get-roleplayer-constraints (getf constraint-topics :roleplayer-constraints))))
+		  (get-roleplayer-constraints
+		   (getf constraint-topics :roleplayer-constraints)
+		   :revision revision)))
 	     (concatenate 'string "\"rolePlayerConstraints\":"  value)))
 	  (otherrole-constraints
 	   (let ((value
-		  (get-otherrole-constraints (getf constraint-topics :otherrole-constraints))))
+		  (get-otherrole-constraints
+		   (getf constraint-topics :otherrole-constraints)
+		   :revision revision)))
 	     (concatenate 'string "\"otherRoleConstraints\":" value))))
       (let ((json-string
-	     (concatenate 'string "{" associationtype "," associationrole-constraints "," roleplayer-constraints ","
-			  otherrole-constraints "," associationtypescope-constraints "}")))
+	     (concatenate 'string "{" associationtype "," associationrole-constraints
+			  "," roleplayer-constraints ","
+			  otherrole-constraints "," associationtypescope-constraints
+			  "}")))
 	json-string))))
 
 
-(defun get-otherrole-constraints (constraint-topics)
+(defun get-otherrole-constraints (constraint-topics &key (revision *TM-REVISION*))
   "Returns a list of the form
-   ((::role <topic> :player <topic> :otherrole <topic> :othertopic <topic> :card-min <string> :card-max <string>) <...>)
+   ((::role <topic> :player <topic> :otherrole <topic> :othertopic <topic>
+   :card-min <string> :card-max <string>) <...>)
    which describes an otherrole constraint for the parent-association of a give type."
-  (let ((applies-to (get-item-by-psi *applies-to-psi*))
-	(constraint-role (get-item-by-psi *constraint-role-psi*))
-	(topictype-role (get-item-by-psi *topictype-role-psi*))
-	(roletype-role (get-item-by-psi *roletype-role-psi*))
-	(othertopictype-role (get-item-by-psi *othertopictype-role-psi*))
-	(otherroletype-role (get-item-by-psi *otherroletype-role-psi*))
-	(roletype (get-item-by-psi *roletype-psi*))
-	(roletype-constraint (is-type-constrained :what *roletype-constraint-psi*))
-	(topictype (get-item-by-psi *topictype-psi*))
-	(topictype-constraint (is-type-constrained)))
+  (declare (list constraint-topics)
+	   (type (or integer null) revision))
+  (let ((applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(topictype-role (get-item-by-psi *topictype-role-psi* :revision revision))
+	(roletype-role (get-item-by-psi *roletype-role-psi* :revision revision))
+	(othertopictype-role (get-item-by-psi *othertopictype-role-psi*
+					      :revision revision))
+	(otherroletype-role (get-item-by-psi *otherroletype-role-psi*
+					     :revision revision))
+	(roletype (get-item-by-psi *roletype-psi* :revision revision))
+	(roletype-constraint (is-type-constrained :what *roletype-constraint-psi*
+						  :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision)))
     (let ((otherrole-constraints
 	   (loop for constraint-topic in constraint-topics
 	      append (let ((players nil)
@@ -112,13 +150,22 @@
 			   (otherplayers nil)
 			   (otherroletypes nil)
 			   (constraint-list
-			    (get-constraint-topic-values constraint-topic)))
-		       (loop for role in (player-in-roles constraint-topic)
-			  when (and (eq constraint-role (instance-of role))
-				    (eq applies-to (instance-of (parent role))))
-			  do (loop for other-role in (roles (parent role))
-				do (let ((current-player (player other-role))
-					 (current-role (instance-of other-role)))
+			    (get-constraint-topic-values constraint-topic
+							 :revision revision)))
+		       (loop for role in (player-in-roles constraint-topic
+							  :revision revision)
+			  when (and (eq constraint-role
+					(instance-of role :revision revision))
+				    (eq applies-to (instance-of
+						    (parent role :revision revision)
+						    :revision revision)))
+			  do (loop for other-role in (roles
+						      (parent role :revision revision)
+						      :revision revision)
+				do (let ((current-player
+					  (player other-role :revision revision))
+					 (current-role
+					  (instance-of other-role :revision revision)))
 				     (cond
 				       ((eq topictype-role current-role)
 					(push current-player players))
@@ -128,26 +175,47 @@
 					(push current-player otherplayers))
 				       ((eq otherroletype-role current-role)
 					(push current-player otherroletypes))))))
-		       (when (and (append players roletypes otherplayers otherroletypes)
-				  (or (not players) (not roletypes) (not otherplayers) (not otherroletypes)))
+		       (when (and (append
+				   players roletypes otherplayers otherroletypes)
+				  (or (not players) (not roletypes)
+				      (not otherplayers) (not otherroletypes)))
 			 (error "otherroletype-constraint ~a is not complete:~%players: ~a~%roletypes: ~a~%otherplayers: ~a~%otherroletypes: ~a~%"
 				(uri (first (psis constraint-topic)))
-				(map 'list #'(lambda(x)(uri (first (psis x)))) players)
-				(map 'list #'(lambda(x)(uri (first (psis x)))) roletypes)
-				(map 'list #'(lambda(x)(uri (first (psis x)))) otherplayers)
-				(map 'list #'(lambda(x)(uri (first (psis x)))) otherroletypes)))
+				(map 'list
+				     #'(lambda(x)
+					 (uri (first (psis x :revision revision))))
+				     players)
+				(map 'list 
+				     #'(lambda(x)
+					 (uri (first (psis x :revision revision))))
+				     roletypes)
+				(map 'list 
+				     #'(lambda(x)
+					 (uri (first (psis x :revision revision))))
+				     otherplayers)
+				(map 'list 
+				     #'(lambda(x)
+					 (uri (first (psis x :revision revision))))
+				     otherroletypes)))
 		       (let ((cross-product-1
 			      (loop for player in players
 				 append (loop for roletype in roletypes
-					   collect (list :player player :role roletype))))
+					   collect (list :player player
+							 :role roletype))))
 			     (cross-product-2
 			      (loop for otherplayer in otherplayers
 				   append (loop for otherroletype in otherroletypes
-					     collect (list :otherplayer otherplayer :otherrole otherroletype)))))
+					     collect
+					       (list :otherplayer otherplayer
+						     :otherrole otherroletype)))))
 			 (let ((cross-product
 				(loop for tupple-1 in cross-product-1
-				     append (loop for tupple-2 in cross-product-2
-					       collect (append tupple-1 tupple-2 (list :constraint constraint-list))))))
+				     append
+				     (loop for tupple-2 in cross-product-2
+					collect
+					  (append
+					   tupple-1 tupple-2
+					   (list :constraint constraint-list))))))
 			   cross-product))))))
       (let ((involved-topic-tupples
 	     (remove-duplicates
@@ -156,10 +224,14 @@
 			       (role-type (getf otherrole-constraint :role))
 			       (otherplayer (getf otherrole-constraint :otherplayer))
 			       (otherrole-type (getf otherrole-constraint :otherrole)))
-			   (topictype-p player)
-			   (topictype-p role-type roletype roletype-constraint)
-			   (topictype-p otherplayer)
-			   (topictype-p otherrole-type roletype roletype-constraint)
+			   (topictype-p player topictype topictype-constraint
+					nil revision)
+			   (topictype-p role-type roletype roletype-constraint
+					nil revision)
+			   (topictype-p otherplayer topictype topictype-constraint
+					nil revision)
+			   (topictype-p otherrole-type roletype roletype-constraint
+					nil revision)
 			   (list :player player
 				 :role role-type
 				 :otherplayer otherplayer
@@ -174,105 +246,176 @@
 	     do (let ((constraint-lists
 		       (remove-duplicate-constraints
 			(loop for otherrole-constraint in otherrole-constraints
-			   when (and (eq (getf otherrole-constraint :player) (getf involved-topic-tupple :player))
-				     (eq (getf otherrole-constraint :role) (getf involved-topic-tupple :role))
-				     (eq (getf otherrole-constraint :otherplayer) (getf involved-topic-tupple :otherplayer))
-				     (eq (getf otherrole-constraint :otherrole) (getf involved-topic-tupple :otherrole)))
+			   when (and (eq (getf otherrole-constraint :player)
+					 (getf involved-topic-tupple :player))
+				     (eq (getf otherrole-constraint :role)
+					 (getf involved-topic-tupple :role))
+				     (eq (getf otherrole-constraint :otherplayer)
+					 (getf involved-topic-tupple :otherplayer))
+				     (eq (getf otherrole-constraint :otherrole)
+					 (getf involved-topic-tupple :otherrole)))
 			   collect (getf otherrole-constraint :constraint)))))
 		  (when (> (length constraint-lists) 1)
 		    (error "found contrary otherrole-constraints:~%player: ~a~%role: ~a~%otherplayer: ~a~%otherrole: ~a~% ~a~%"
-			   (uri (first (psis (getf involved-topic-tupple :player))))
-			   (uri (first (psis (getf involved-topic-tupple :role))))
-			   (uri (first (psis (getf involved-topic-tupple :otherplayer))))
-			   (uri (first (psis (getf involved-topic-tupple :otherrole))))
+			   (uri (first (psis (getf involved-topic-tupple :player)
+					     :revision revision)))
+			   (uri (first (psis (getf involved-topic-tupple :role)
+					     :revision revision)))
+			   (uri (first (psis (getf involved-topic-tupple :otherplayer)
+					     :revision revision)))
+			   (uri (first (psis (getf involved-topic-tupple :otherrole)
+					     :revision revision)))
 			   constraint-lists))
 
 		  (let ((json-player-type
-			 (concatenate 'string "\"playerType\":"
-				      (topics-to-json-list (getf (list-subtypes (getf involved-topic-tupple :player) nil nil) :subtypes))))
+			 (concatenate
+			  'string "\"playerType\":"
+			  (topics-to-json-list
+			   (getf (list-subtypes (getf involved-topic-tupple :player)
+						nil nil nil nil revision)
+				 :subtypes) :revision revision)))
 			(json-player
-			 (concatenate 'string "\"players\":"
-				      (topics-to-json-list
-				       (list-instances (getf involved-topic-tupple :player) topictype topictype-constraint))))
+			 (concatenate
+			  'string "\"players\":"
+			  (topics-to-json-list
+			   (list-instances (getf involved-topic-tupple :player)
+					   topictype topictype-constraint revision)
+			   :revision revision)))
 			(json-role
-			 (concatenate 'string "\"roleType\":"
-				      (topics-to-json-list
-				       (getf (list-subtypes (getf involved-topic-tupple :role) roletype roletype-constraint) :subtypes))))
+			 (concatenate
+			  'string "\"roleType\":"
+			  (topics-to-json-list
+			   (getf (list-subtypes (getf involved-topic-tupple :role)
+						roletype roletype-constraint nil
+						nil revision)
+				 :subtypes) :revision revision)))
 			(json-otherplayer-type
-			 (concatenate 'string "\"otherPlayerType\":"
-				      (topics-to-json-list (getf (list-subtypes (getf involved-topic-tupple :otherplayer) nil nil) :subtypes))))
+			 (concatenate
+			  'string "\"otherPlayerType\":"
+			  (topics-to-json-list
+			   (getf (list-subtypes
+				  (getf involved-topic-tupple :otherplayer)
+				  nil nil nil nil revision) :subtypes)
+			   :revision revision)))
 			(json-otherplayer
-			 (concatenate 'string "\"otherPlayers\":"
-				      (topics-to-json-list
-				       (list-instances (getf involved-topic-tupple :otherplayer) topictype topictype-constraint))))
+			 (concatenate
+			  'string "\"otherPlayers\":"
+			  (topics-to-json-list
+			   (list-instances (getf involved-topic-tupple :otherplayer)
+					   topictype topictype-constraint revision)
+			   :revision revision)))
 			(json-otherrole
-			 (concatenate 'string "\"otherRoleType\":"
-				      (topics-to-json-list
-				       (getf (list-subtypes (getf involved-topic-tupple :otherrole) roletype roletype-constraint) :subtypes))))
+			 (concatenate
+			  'string "\"otherRoleType\":"
+			  (topics-to-json-list
+			   (getf (list-subtypes
+				  (getf involved-topic-tupple :otherrole)
+				  roletype roletype-constraint nil nil revision)
+				 :subtypes) :revision revision)))
 			(card-min
-			 (concatenate 'string "\"cardMin\":" (getf (first constraint-lists) :card-min)))
+			 (concatenate 'string "\"cardMin\":"
+				      (getf (first constraint-lists) :card-min)))
 			(card-max
-			 (concatenate 'string "\"cardMax\":" (getf (first constraint-lists) :card-max))))
+			 (concatenate 'string "\"cardMax\":"
+				      (getf (first constraint-lists) :card-max))))
 		    (setf cleaned-otherrole-constraints
 			  (concatenate 'string cleaned-otherrole-constraints
-				       "{" json-player-type "," json-player "," json-role "," json-otherplayer-type "," json-otherplayer "," json-otherrole "," card-min "," card-max "},")))))
+				       "{" json-player-type "," json-player ","
+				       json-role "," json-otherplayer-type ","
+				       json-otherplayer "," json-otherrole ","
+				       card-min "," card-max "},")))))
 	  (if (string= cleaned-otherrole-constraints "[")
 	      (setf cleaned-otherrole-constraints "null")
 	      (setf cleaned-otherrole-constraints 
-		    (concatenate 'string (subseq cleaned-otherrole-constraints 0 (- (length cleaned-otherrole-constraints) 1)) "]")))
+		    (concatenate
+		     'string (subseq cleaned-otherrole-constraints 0
+				     (- (length cleaned-otherrole-constraints) 1))
+		     "]")))
 	  cleaned-otherrole-constraints)))))
 
 
-(defun get-roleplayer-constraints (constraint-topics)
+(defun get-roleplayer-constraints (constraint-topics &key (revision *TM-REVISION*))
   "Returns a list of the form
    ((:role <topic> :player <topic> :card-min <string> :card-max <string>) <...>)
    which describes the cardinality of topctypes used as players in roles of given
    types in an association of a given type which is also the parent if this list."
-  (let ((applies-to (get-item-by-psi *applies-to-psi*))
-	(constraint-role (get-item-by-psi *constraint-role-psi*))
-	(topictype-role (get-item-by-psI *topictype-role-psi*))
-	(roletype-role (get-item-by-psi *roletype-role-psi*))
-	(roletype (get-item-by-psi *roletype-psi*))
-	(roletype-constraint (is-type-constrained :what *roletype-constraint-psi*))
-	(topictype (get-item-by-psi *topictype-psi*))
-	(topictype-constraint (is-type-constrained)))
+  (declare (type (or integer null) revision)
+	   (list constraint-topics))
+  (let ((applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(topictype-role (get-item-by-psI *topictype-role-psi* :revision revision))
+	(roletype-role (get-item-by-psi *roletype-role-psi* :revision revision))
+	(roletype (get-item-by-psi *roletype-psi* :revision revision))
+	(roletype-constraint (is-type-constrained :what *roletype-constraint-psi*
+						  :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision)))
     (let ((roleplayer-constraints
 	   (loop for constraint-topic in constraint-topics
 	      append (let ((constraint-list
-			    (get-constraint-topic-values constraint-topic)))
+			    (get-constraint-topic-values constraint-topic
+							 :revision revision)))
 		       (let ((players
-			      (loop for role in (player-in-roles constraint-topic)
-				 when (and (eq constraint-role (instance-of role))
-					   (eq applies-to (instance-of (parent role))))
-				 append (loop for other-role in (roles (parent role))
-					   when (eq topictype-role (instance-of other-role))
-					   collect (player other-role))))
+			      (loop for role in (player-in-roles constraint-topic
+								 :revision revision)
+				 when (and (eq constraint-role
+					       (instance-of role :revision revision))
+					   (eq applies-to
+					       (instance-of
+						(parent role :revision revision)
+						:revision revision)))
+				 append (loop for other-role in
+					     (roles (parent role :revision revision)
+						    :revision revision)
+					   when (eq topictype-role
+						    (instance-of other-role
+								 :revision revision))
+					   collect (player other-role
+							   :revision revision))))
 			     (roles
-			      (loop for role in (player-in-roles constraint-topic)
-				 when (and (eq constraint-role (instance-of role))
-					   (eq applies-to (instance-of (parent role))))
+			      (loop for role in (player-in-roles constraint-topic
+								 :revision revision)
+				 when (and (eq constraint-role
+					       (instance-of role :revision revision))
+					   (eq applies-to
+					       (instance-of
+						(parent role :revision revision)
+						:revision revision)))
 				 append (loop for other-role in (roles (parent role))
-					   when (eq roletype-role (instance-of other-role))
+					   when (eq roletype-role
+						    (instance-of other-role
+								 :revision revision))
 					   collect (player other-role)))))
 			 (when (or (and players (not roles))
 				   (and roles (not players)))
 			   (error "roleplayer-constraint ~a is not complete:~%players: ~a~%roles: ~a~%"
-				  (uri (first (psis constraint-topic)))
-				  (map 'list #'(lambda(x)(uri (first (psis x)))) players)
-				  (map 'list #'(lambda(x)(uri (first (psis x)))) roles)))
+				  (uri (first (psis constraint-topic
+						    :revision revision)))
+				  (map 'list
+				       #'(lambda(x)
+					   (uri (first (psis x :revision revision))))
+				       players)
+				  (map 'list
+				       #'(lambda(x)
+					   (uri (first (psis x :revision revision))))
+				       roles)))
 			 (let ((cross-product
 				(loop for player in players
 				   append (loop for role in roles
-					     collect (list :player player :role role :constraint constraint-list)))))
+					     collect
+					       (list :player player
+						     :role role
+						     :constraint constraint-list)))))
 			   cross-product))))))
-
       (let ((role-player-tupples
 	     (remove-duplicates
 	      (loop for roleplayer-constraint in roleplayer-constraints
 		 collect (let ((current-player (getf roleplayer-constraint :player))
 			       (current-role (getf roleplayer-constraint :role)))
-			   (topictype-p current-player)
-			   (topictype-p current-role roletype roletype-constraint)
+			   (topictype-p current-player topictype topictype-constraint
+					nil revision)
+			   (topictype-p current-role roletype roletype-constraint
+					nil revision)
 			   (list :player current-player
 				 :role current-role)))  
 	      :test #'(lambda(x y)
@@ -283,109 +426,163 @@
 	     do (let ((constraint-lists
 		       (remove-duplicate-constraints
 			(loop for roleplayer-constraint in roleplayer-constraints
-			   when (and (eq (getf roleplayer-constraint :player) (getf role-player-tupple :player))
-				     (eq (getf roleplayer-constraint :role) (getf role-player-tupple :role)))
+			   when (and (eq (getf roleplayer-constraint :player)
+					 (getf role-player-tupple :player))
+				     (eq (getf roleplayer-constraint :role)
+					 (getf role-player-tupple :role)))
 			   collect (getf roleplayer-constraint :constraint)))))
 		  (when (> (length constraint-lists) 1)
 		    (error "found contrary roleplayer-constraints:~%role: ~a~%player: ~a~% ~a ~%"
-			   (uri (first (psis (getf role-player-tupple :role))))
-			   (uri (first (psis (getf role-player-tupple :player))))
+			   (uri (first (psis (getf role-player-tupple :role)
+					     :revision revision)))
+			   (uri (first (psis (getf role-player-tupple :player)
+					     :revision revision)))
 			   constraint-lists))
 		  (let ((json-player-type
-			 (concatenate 'string "\"playerType\":"
-				      (topics-to-json-list (getf (list-subtypes (getf role-player-tupple :player) nil nil) :subtypes))))
+			 (concatenate
+			  'string "\"playerType\":"
+			  (topics-to-json-list
+			   (getf (list-subtypes (getf role-player-tupple :player)
+						nil nil nil nil revision) :subtypes)
+			   :revision revision)))
 			(json-players
-			 (concatenate 'string "\"players\":"
-				      (topics-to-json-list
-				       (list-instances (getf role-player-tupple :player) topictype topictype-constraint))))
+			 (concatenate
+			  'string "\"players\":"
+			  (topics-to-json-list
+			   (list-instances (getf role-player-tupple :player)
+					   topictype topictype-constraint revision)
+			   :revision revision)))
 			(json-role
-			 (concatenate 'string "\"roleType\":"
-				      (topics-to-json-list
-				       (getf (list-subtypes (getf role-player-tupple :role) roletype roletype-constraint) :subtypes))))
+			 (concatenate
+			  'string "\"roleType\":"
+			  (topics-to-json-list
+			   (getf (list-subtypes (getf role-player-tupple :role)
+						roletype roletype-constraint nil
+						nil revision)
+				 :subtypes)
+			   :revision revision)))
 			(card-min
-			 (concatenate 'string "\"cardMin\":" (getf (first constraint-lists) :card-min)))
+			 (concatenate
+			  'string "\"cardMin\":"
+			  (getf (first constraint-lists) :card-min)))
 			(card-max
-			 (concatenate 'string "\"cardMax\":" (getf (first constraint-lists) :card-max))))
+			 (concatenate
+			  'string "\"cardMax\":"
+			  (getf (first constraint-lists) :card-max))))
 		    (setf cleaned-roleplayer-constraints
 			  (concatenate 'string cleaned-roleplayer-constraints
-				       "{" json-player-type "," json-players "," json-role "," card-min "," card-max "},")))))
+				       "{" json-player-type "," json-players ","
+				       json-role "," card-min "," card-max "},")))))
 	  (if (string= cleaned-roleplayer-constraints "[")
 	      (setf cleaned-roleplayer-constraints "null")
 	      (setf cleaned-roleplayer-constraints 
-		    (concatenate 'string (subseq cleaned-roleplayer-constraints 0 (- (length cleaned-roleplayer-constraints) 1)) "]")))
+		    (concatenate
+		     'string (subseq cleaned-roleplayer-constraints 0
+				     (- (length cleaned-roleplayer-constraints) 1))
+		     "]")))
 	  cleaned-roleplayer-constraints)))))
 
 
-(defun get-associationrole-constraints (constraint-topics)
+(defun get-associationrole-constraints (constraint-topics &key
+					(revision *TM-REVISION*))
   "Returns a list of the form
    ((:associationroletype <topic> :card-min <string> :card-max <string>), <...>)
    which describes all associationrole-constraints of the passed
    constraint-topics.
-   If as-json is set to t the return value of this function is a json-string otherwise a
-   list of lists of the following form (:roletype <topic, topic, ...> :cardMin <min> :cardMax <max>)"
-  (let ((applies-to (get-item-by-psi *applies-to-psi*))
-	(roletype-role (get-item-by-psi *roletype-role-psi*))
-	(constraint-role (get-item-by-psi *constraint-role-psi*))
-	(roletype (get-item-by-psi *roletype-psi*))
-	(roletype-constraint (is-type-constrained :what *roletype-constraint-psi*)))
+   If as-json is set to t the return value of this function is a
+   json-string otherwise a list of lists of the following form
+   (:roletype <topic, topic, ...> :cardMin <min> :cardMax <max>)"
+  (declare (type (or integer null) revision)
+	   (list constraint-topics))
+  (let ((applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(roletype-role (get-item-by-psi *roletype-role-psi* :revision revision))
+	(constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(roletype (get-item-by-psi *roletype-psi* :revision revision))
+	(roletype-constraint (is-type-constrained :what *roletype-constraint-psi*
+						  :revision revision)))
     (let ((associationrole-constraints
 	   (loop for constraint-topic in constraint-topics
 	      append (let ((constraint-list
-			    (get-constraint-topic-values constraint-topic)))
-		       (loop for role in (player-in-roles constraint-topic)
-			  when (and (eq constraint-role (instance-of role))
-				    (eq applies-to (instance-of (parent role))))
-			  append (loop for other-role in (roles (parent role))
-				    when (eq roletype-role (instance-of other-role))
-				    collect (list :associationroletype (player other-role)
-						  :constraint constraint-list)))))))
+			    (get-constraint-topic-values constraint-topic
+							 :revision revision)))
+		       (loop for role in (player-in-roles constraint-topic
+							  :revision revision)
+			  when (and (eq constraint-role 
+					(instance-of role :revision revision))
+				    (eq applies-to 
+					(instance-of (parent role :revision revision)
+						     :revision revision)))
+			  append (loop for other-role in
+				      (roles (parent role :revision revision)
+					     :revision revision)
+				    when (eq roletype-role
+					     (instance-of other-role
+							  :revision revision))
+				    collect 
+				      (list :associationroletype
+					    (player other-role :revision revision)
+					    :constraint constraint-list)))))))
       (let ((associationroletype-topics
-	     (remove-duplicates (map 'list #'(lambda(x)
-					       (let ((associationroletype (getf x :associationroletype)))
-						 (topictype-p associationroletype roletype roletype-constraint)
-						 associationroletype))
-				     associationrole-constraints))))
+	     (remove-duplicates
+	      (map 'list #'(lambda(x)
+			     (let ((associationroletype (getf x :associationroletype)))
+			       (topictype-p associationroletype roletype
+					    roletype-constraint nil revision)
+			       associationroletype))
+		   associationrole-constraints))))
 	(let ((cleaned-associationrole-constraints "["))
-	      ;(raw-constraints nil))
 	  (loop for associationroletype-topic in associationroletype-topics
-	     do (let ((constraint-lists
-			    (remove-duplicate-constraints
-			     (loop for associationrole-constraint in associationrole-constraints
-				when (eq associationroletype-topic (getf associationrole-constraint :associationroletype))
-				collect (getf associationrole-constraint :constraint)))))
-		  (when (> (length constraint-lists) 1)
-		    (error "found contrary associationrole-constraints: ~a ~a~%" (uri (first (psis associationroletype-topic))) constraint-lists))
+	     do
+	       (let ((constraint-lists
+		      (remove-duplicate-constraints
+		       (loop for associationrole-constraint in
+			  associationrole-constraints
+			  when (eq associationroletype-topic
+				   (getf associationrole-constraint
+					 :associationroletype))
+			  collect (getf associationrole-constraint :constraint)))))
+		 (when (> (length constraint-lists) 1)
+		   (error "found contrary associationrole-constraints: ~a ~a~%" (uri (first (psis associationroletype-topic :revision revision))) constraint-lists))
 		  (let ((roletype-with-subtypes
 			 (json:encode-json-to-string 
 			  (map 'list #'(lambda(topic)
-					 (map 'list #'uri (psis topic)))
-			       (getf (list-subtypes associationroletype-topic roletype roletype-constraint) :subtypes)))))
-		  (setf cleaned-associationrole-constraints
-			(concatenate 'string
-				     cleaned-associationrole-constraints
-				     "{\"roleType\":" roletype-with-subtypes
-				     ",\"cardMin\":" (getf (first constraint-lists) :card-min)
-				     ",\"cardMax\":" (getf (first constraint-lists) :card-max) "},")))))
-		  
-
+					 (map 'list #'uri
+					      (psis topic :revision revision)))
+			       (getf (list-subtypes associationroletype-topic
+						    roletype roletype-constraint
+						    nil nil revision) :subtypes)))))
+		    (setf cleaned-associationrole-constraints
+			  (concatenate 'string
+				       cleaned-associationrole-constraints
+				       "{\"roleType\":" roletype-with-subtypes
+				       ",\"cardMin\":" (getf (first constraint-lists)
+							     :card-min)
+				       ",\"cardMax\":" (getf (first constraint-lists)
+							     :card-max) "},")))))
 	  (if (string= cleaned-associationrole-constraints "[")
 	      (setf cleaned-associationrole-constraints "null")
 	      (setf cleaned-associationrole-constraints 
-		    (concatenate 'string (subseq cleaned-associationrole-constraints 0 (- (length cleaned-associationrole-constraints) 1)) "]")))
+		    (concatenate
+		     'string (subseq cleaned-associationrole-constraints 0
+				     (- (length cleaned-associationrole-constraints)
+					1)) "]")))
 	  cleaned-associationrole-constraints)))))
 
 
 ;; =============================================================================
 ;; --- all topic constraints ---------------------------------------------------
 ;; =============================================================================
-(defun get-constraints-of-topic (topic-instances &key(treat-as 'type))
+(defun get-constraints-of-topic (topic-instances &key(treat-as 'type)
+				 (revision *TM-REVISION*))
   "Returns a constraint list with the constraints:
    subjectidentifier-constraints, subjectlocator-constraints,
    topicname-constraints, topicoccurrence-constraints and
    uniqueoccurrence-constraints.
    topic-instances should be a list with exactly one item if trea-as is set to type
    otherwise it can constain more items."
-  (declare (list topic-instances))
+  (declare (list topic-instances)
+	   (symbol treat-as)
+	   (type (or integer null) revision))
   (when (and (> (length topic-instances) 1)
 	     (not (eql treat-as 'type)))
     (error "From get-constraints-of-topic: topic-instances must contain exactly one item when treated as instance!"))
@@ -398,14 +595,17 @@
 	(uniqueoccurrence-constraints nil))
     (loop for topic-instance in topic-instances
        do (let ((current-constraints
-		 (get-all-constraint-topics-of-topic topic-instance :treat-as treat-as)))
+		 (get-all-constraint-topics-of-topic topic-instance
+						     :treat-as treat-as
+						     :revision revision)))
 	    (dolist (item (getf current-constraints :abstract-topictype-constraints))
 	      (pushnew item abstract-topictype-constraints))
 	    (dolist (item (getf current-constraints :exclusive-instance-constraints))
 	      (let ((current-list
 		     (list topic-instance (list item))))
 		(let ((found-item
-		       (find current-list exclusive-instance-constraints :key #'first)))
+		       (find current-list exclusive-instance-constraints
+			     :key #'first)))
 		  (if found-item
 		      (dolist (inner-item (second current-list))
 			(pushnew inner-item (second found-item)))
@@ -423,28 +623,41 @@
     (let ((exclusive-instance-constraints
 	   (let ((value "["))
 	     (loop for exclusive-instance-constraint in exclusive-instance-constraints
-		do (setf value (concatenate 'string value
-					    (get-exclusive-instance-constraints (first exclusive-instance-constraint)
-										(second exclusive-instance-constraint)) ",")))
+		do (setf value
+			 (concatenate 'string value
+				      (get-exclusive-instance-constraints
+				       (first exclusive-instance-constraint)
+				       (second exclusive-instance-constraint)
+				       :revision revision) ",")))
 	     (if (string= value "[")
 		 (setf value "null")
-		 (setf value (concatenate 'string (subseq value 0 (- (length value) 1)) "]")))
+		 (setf value (concatenate 'string (subseq value 0
+							  (- (length value) 1)) "]")))
 	     (concatenate 'string "\"exclusiveInstances\":" value)))
 	  (subjectidentifier-constraints
 	   (let ((value
-		  (get-simple-constraints subjectidentifier-constraints :error-msg-constraint-name "subjectidentifier")))
+		  (get-simple-constraints
+		   subjectidentifier-constraints
+		   :error-msg-constraint-name "subjectidentifier"
+		   :revision revision)))
 	     (concatenate 'string "\"subjectIdentifierConstraints\":" value)))
 	  (subjectlocator-constraints
 	   (let ((value
-		  (get-simple-constraints subjectlocator-constraints :error-msg-constraint-name "subjectlocator")))
+		  (get-simple-constraints
+		   subjectlocator-constraints
+		   :error-msg-constraint-name "subjectlocator"
+		   :revision revision)))
 	     (concatenate 'string "\"subjectLocatorConstraints\":" value)))
 	  (topicname-constraints
 	   (let ((value
-		  (get-topicname-constraints topicname-constraints)))
+		  (get-topicname-constraints topicname-constraints
+					     :revision revision)))
 	     (concatenate 'string "\"topicNameConstraints\":" value)))
 	  (topicoccurrence-constraints
 	   (let ((value
-		  (get-topicoccurrence-constraints topicoccurrence-constraints uniqueoccurrence-constraints)))
+		  (get-topicoccurrence-constraints topicoccurrence-constraints
+						   uniqueoccurrence-constraints
+						   :revision revision)))
 	     (concatenate 'string "\"topicOccurrenceConstraints\":" value)))
 	  (abstract-constraint
 	   (concatenate 'string "\"abstractConstraint\":"
@@ -452,54 +665,89 @@
 			    "true"
 			    "false"))))
       (let ((json-string
-	     (concatenate 'string "{" exclusive-instance-constraints "," subjectidentifier-constraints
+	     (concatenate 'string "{" exclusive-instance-constraints ","
+			  subjectidentifier-constraints
 			  "," subjectlocator-constraints "," topicname-constraints ","
 			  topicoccurrence-constraints "," abstract-constraint "}")))
         json-string))))
 
 
-(defun get-exclusive-instance-constraints(owner exclusive-instances-lists)
+(defun get-exclusive-instance-constraints(owner exclusive-instances-lists
+					  &key (revision *TM-REVISION*))
   "Returns a JSON-obejct of the following form:
    {owner: [psi-1, psi-2], exclusives: [[psi-1-1, psi-1-2], [psi-2-1, <...>], <...>]}."
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(topictype-role (get-item-by-psi *topictype-role-psi*))
-	(topictype (get-item-by-psi *topictype-psi*))
-	(topictype-constraint (is-type-constrained)))
+  (declare (type (or integer null) revision))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(topictype-role (get-item-by-psi *topictype-role-psi* :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision)))
     (let ((topics
 	   (remove-duplicates
 	    (loop for exclusive-instances-list in exclusive-instances-lists
-	       append (let ((owner (getf exclusive-instances-list :owner))
-			    (exclusive-constraints (getf exclusive-instances-list :exclusive-constraints)))
-			(loop for exclusive-constraint in exclusive-constraints
-			   append (loop for role in (player-in-roles exclusive-constraint)
-				     when (and (eq constraint-role (instance-of role))
-					       (eq applies-to (instance-of (parent role))))
-				     append (loop for other-role in (roles (parent role))
-					       when (and (eq topictype-role (instance-of other-role))
-							 (not (eq owner (player other-role))))
-					       ;collect (player other-role)))))))))
-					       append (getf (list-subtypes (player other-role) topictype topictype-constraint) :subtypes)))))))))
-      (concatenate 'string "{\"owner\":" (json-exporter::identifiers-to-json-string owner)
+	       append
+		 (let ((owner (getf exclusive-instances-list :owner))
+		       (exclusive-constraints
+			(getf exclusive-instances-list :exclusive-constraints)))
+		   (loop for exclusive-constraint in exclusive-constraints
+		      append
+			(loop for role in
+			     (player-in-roles exclusive-constraint
+					      :revision revision)
+			   when (and (eq constraint-role
+					 (instance-of role
+						      :revision revision))
+				     (eq applies-to (instance-of
+						     (parent role :revision revision)
+						     :revision revision)))
+			   append
+			     (loop for other-role in
+				  (roles
+				   (parent role :revision revision)
+				   :revision revision)
+				when (and (eq topictype-role
+					      (instance-of other-role
+							   :revision revision))
+					  (not
+					   (eq owner (player other-role
+							     :revision revision))))
+				append
+				  (getf
+				   (list-subtypes
+				    (player other-role :revision revision)
+				    topictype topictype-constraint nil
+				    nil revision) :subtypes)))))))))
+      (concatenate 'string "{\"owner\":" (json-exporter::identifiers-to-json-string
+					  owner :revision revision)
 		   ",\"exclusives\":"
-		   (json:encode-json-to-string (map 'list #'(lambda(y)
-							      (map 'list #'uri y))
-						    (map 'list #'psis topics))) "}"))))
+		   (json:encode-json-to-string
+		    (map 'list #'(lambda(y)
+				   (map 'list #'uri y))
+			 (map 'list #'(lambda(z)
+					(psis z :revision revision))
+			      topics))) "}"))))
 
 
-(defun get-simple-constraints(constraint-topics &key (error-msg-constraint-name "uniqueoccurrence"))
+(defun get-simple-constraints(constraint-topics &key
+			      (error-msg-constraint-name "uniqueoccurrence")
+			      (revision *TM-REVISION*))
   "Returns a list of the form
    ((:regexp <string> :card-min <string> :card-max <string>))
    which contains the subjectidentifier, subjectlocator or
    unique-occurrence constraints. This depends on the passed
    constraint-topics."
+  (declare (list constraint-topics)
+	   (string error-msg-constraint-name)
+	   (type (or integer null) revision))
   (let ((all-values
 	 (remove-duplicate-constraints
 	  (loop for constraint-topic in constraint-topics
-	     collect (get-constraint-topic-values constraint-topic)))))
+	     collect (get-constraint-topic-values constraint-topic
+						  :revision revision)))))
     (let ((contrary-constraints (find-contrary-constraints all-values)))
       (when contrary-constraints
-	(error "found contrary ~a-constraints: ~a~%" error-msg-constraint-name contrary-constraints)))
+	(error "found contrary ~a-constraints: ~a~%"
+	       error-msg-constraint-name contrary-constraints)))
     (simple-constraints-to-json all-values)))
 
 
@@ -510,13 +758,15 @@
    [{regexp: expr, cardMin: 123, cardMax: 456}, <...>]."
   (let ((constraints "["))
     (loop for constraint in simple-constraints
-       do (let ((constraint (concatenate 'string "{\"regexp\":"
-					 (json:encode-json-to-string (getf constraint :regexp))
-					 ",\"cardMin\":"
-					 (json:encode-json-to-string (getf constraint :card-min))
-					 ",\"cardMax\":"
-					 (json:encode-json-to-string (getf constraint :card-max))
-					 "}")))
+       do (let ((constraint
+		 (concatenate
+		  'string "{\"regexp\":"
+		  (json:encode-json-to-string (getf constraint :regexp))
+		  ",\"cardMin\":"
+		  (json:encode-json-to-string (getf constraint :card-min))
+		  ",\"cardMax\":"
+		  (json:encode-json-to-string (getf constraint :card-max))
+		  "}")))
 	    (if (string= constraints "[")
 		(setf constraints (concatenate 'string constraints constraint))
 		(setf constraints (concatenate 'string constraints "," constraint)))))
@@ -526,34 +776,53 @@
     constraints))
 
 
-(defun get-topicname-constraints(constraint-topics)
+(defun get-topicname-constraints(constraint-topics &key (revision *TM-REVISION*))
   "Returns all topicname constraints as a list of the following form:
   [{nametypescopes:[{nameType: [psi-1, psi-2], scopeConstraints: [<scopeConstraint>]},
                     {nameType: [subtype-1-psi-1], scopeConstraints: [<scopeConstraints>]},
     constraints: [<simpleConstraint>, <...>]},
     <...>]."
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(nametype-role (get-item-by-psi *nametype-role-psi*))
-	(nametype (get-item-by-psi *nametype-psi*))
-	(nametype-constraint (is-type-constrained :what *nametype-constraint-psi*)))
+  (declare (type (or integer null) revision)
+	   (list constraint-topics))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(nametype-role (get-item-by-psi *nametype-role-psi* :revision revision))
+	(nametype (get-item-by-psi *nametype-psi* :revision revision))
+	(nametype-constraint (is-type-constrained :what *nametype-constraint-psi*
+						  :revision revision)))
     (let ((topicname-constraints
-	   (remove-if #'null
-		      (loop for constraint-topic in constraint-topics
-			 append (loop for role in (player-in-roles constraint-topic)
-				   when (and (eq constraint-role (instance-of role))
-					     (eq applies-to (instance-of (parent role))))
-				   append (loop for other-role in (roles (parent role))
-					     when (eq nametype-role (instance-of other-role))
-					     collect (let ((nametype-topic (player other-role))
-							   (constraint-list (get-constraint-topic-values constraint-topic)))
-						       (list :type nametype-topic :constraint constraint-list))))))))
+	   (remove-if
+	    #'null
+	    (loop for constraint-topic in constraint-topics
+	       append
+		 (loop for role in (player-in-roles constraint-topic
+						    :revision revision)
+		    when (and (eq constraint-role
+				  (instance-of role :revision revision))
+			      (eq applies-to
+				  (instance-of (parent role :revision revision)
+					       :revision revision)))
+		    append
+		      (loop for other-role in
+			   (roles (parent role :revision revision)
+				  :revision revision)
+			 when (eq nametype-role 
+				  (instance-of other-role :revision revision))
+			 collect
+			   (let ((nametype-topic
+				  (player other-role :revision revision))
+				 (constraint-list
+				  (get-constraint-topic-values constraint-topic
+							       :revision revision)))
+			     (list :type nametype-topic
+				   :constraint constraint-list))))))))
       (let ((nametype-topics
 	     (remove-duplicates
 	      (map 'list #'(lambda(x)
 			     (let ((topicname-type
 				    (getf x :type)))
-			       (topictype-p topicname-type nametype nametype-constraint)
+			       (topictype-p topicname-type nametype
+					    nametype-constraint nil revision)
 			       topicname-type))
 		   topicname-constraints))))
 	(let ((cleaned-topicname-constraints "["))
@@ -566,31 +835,55 @@
 		  (let ((contrary-constraints
 			 (find-contrary-constraints constraint-lists)))
 		    (when contrary-constraints
-		      (error "found contrary topicname-constraints: ~a~%" contrary-constraints)))
+		      (error "found contrary topicname-constraints: ~a~%"
+			     contrary-constraints)))
 		  (let ((nametype-with-subtypes
-			 (remove-if #'null (getf (list-subtypes nametype-topic nametype nametype-constraint) :subtypes))))
+			 (remove-if
+			  #'null
+			  (getf (list-subtypes nametype-topic nametype
+					       nametype-constraint nil nil revision)
+				:subtypes))))
 		    (let ((nametypescopes "\"nametypescopes\":["))
 		      (loop for current-topic in nametype-with-subtypes
 			 do (let ((current-json-string
-				   (concatenate 'string "{\"nameType\":" (json-exporter::identifiers-to-json-string current-topic)
-						",\"scopeConstraints\":" (get-typescope-constraints current-topic :what 'topicname) "}")))
-			      (setf nametypescopes (concatenate 'string nametypescopes current-json-string ","))))
+				   (concatenate
+				    'string "{\"nameType\":"
+				    (json-exporter::identifiers-to-json-string
+				     current-topic :revision revision)
+				    ",\"scopeConstraints\":"
+				    (get-typescope-constraints current-topic
+							       :what 'topicname
+							       :revision revision)
+				    "}")))
+			      (setf nametypescopes
+				    (concatenate 'string nametypescopes
+						 current-json-string ","))))
 		      (if (string= nametypescopes "\"nametypescopes\"[")
 			  (setf nametypescopes "null")
 			  (setf nametypescopes
-				(concatenate 'string (subseq nametypescopes 0 (- (length nametypescopes) 1)) "]")))
+				(concatenate 
+				 'string (subseq nametypescopes 0
+						 (- (length nametypescopes) 1)) "]")))
 		      (let ((json-constraint-lists
-			     (concatenate 'string "\"constraints\":" (simple-constraints-to-json constraint-lists))))
+			     (concatenate
+			      'string "\"constraints\":"
+			      (simple-constraints-to-json constraint-lists))))
 			(setf cleaned-topicname-constraints
-			      (concatenate 'string cleaned-topicname-constraints "{" nametypescopes "," json-constraint-lists "},")))))))
+			      (concatenate
+			       'string cleaned-topicname-constraints "{"
+			       nametypescopes "," json-constraint-lists "},")))))))
 	  (if (string= cleaned-topicname-constraints "[")
 	      (setf cleaned-topicname-constraints "null")
 	      (setf cleaned-topicname-constraints
-		    (concatenate 'string (subseq cleaned-topicname-constraints 0 (- (length cleaned-topicname-constraints) 1)) "]")))
+		    (concatenate
+		     'string (subseq cleaned-topicname-constraints 0
+				     (- (length cleaned-topicname-constraints) 1))
+		     "]")))
 	  cleaned-topicname-constraints)))))
 
 
-(defun get-topicoccurrence-constraints(constraint-topics unique-constraint-topics)
+(defun get-topicoccurrence-constraints(constraint-topics unique-constraint-topics
+				       &key (revision *TM-REVISION*))
   "Returns all topicoccurrence constraints as a list of the following form:
    [{occurrenceTypes:[{occurrenceType:[psi-1,psi-2],
 		       scopeConstraints:[<scopeConstraints>],
@@ -599,105 +892,177 @@
    constraints:[<simpleConstraints>, <...>],
    uniqueConstraint:[<uniqueConstraints>, <...> ]}
    <...>]."
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(occurrencetype-role (get-item-by-psi *occurrencetype-role-psi*))
-	(occurrencetype (get-item-by-psi *occurrencetype-psi*))
-	(occurrencetype-constraint (is-type-constrained :what *occurrencetype-constraint-psi*)))
+  (declare (type (or integer null) revision)
+	   (list constraint-topics unique-constraint-topics))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(occurrencetype-role (get-item-by-psi *occurrencetype-role-psi*
+					      :revision revision))
+	(occurrencetype (get-item-by-psi *occurrencetype-psi*
+					 :revision revision))
+	(occurrencetype-constraint
+	 (is-type-constrained :what *occurrencetype-constraint-psi*
+			      :revision revision)))
     (let ((topicoccurrence-constraints
-	   (remove-if #'null
-		      (loop for constraint-topic in constraint-topics
-			 append (loop for role in (player-in-roles constraint-topic)
-				   when (and (eq constraint-role (instance-of role))
-					     (eq applies-to (instance-of (parent role))))
-				   append (loop for other-role in (roles (parent role))
-					     when (eq occurrencetype-role (instance-of other-role))
-					     collect (let ((occurrencetype-topic (player other-role))
-							   (constraint-list (get-constraint-topic-values constraint-topic)))
-						       (list :type occurrencetype-topic :constraint constraint-list))))))))
+	   (remove-if
+	    #'null
+	    (loop for constraint-topic in constraint-topics
+	       append
+		 (loop for role in (player-in-roles constraint-topic
+						    :revision revision)
+		    when (and (eq constraint-role
+				  (instance-of role :revision revision))
+			      (eq applies-to 
+				  (instance-of (parent role :revision revision)
+					       :revision revision)))
+		    append
+		      (loop for other-role in (roles (parent role :revision revision)
+						     :revision revision)
+			 when (eq occurrencetype-role
+				  (instance-of other-role :revision revision))
+			 collect
+			   (let ((occurrencetype-topic
+				  (player other-role :revision revision))
+				 (constraint-list
+				  (get-constraint-topic-values constraint-topic
+							       :revision revision)))
+			     (list :type occurrencetype-topic
+				   :constraint constraint-list))))))))
       (let ((occurrencetype-topics
 	     (remove-duplicates
-	      (map 'list #'(lambda(x)
-			     (let ((occurrence-type (getf x :type)))
-			       (topictype-p occurrence-type occurrencetype occurrencetype-constraint)
-			       occurrence-type))
+	      (map 'list
+		   #'(lambda(x)
+		       (let ((occurrence-type (getf x :type)))
+			 (topictype-p occurrence-type occurrencetype
+				      occurrencetype-constraint nil revision)
+			 occurrence-type))
 		   topicoccurrence-constraints))))
 	(let ((cleaned-topicoccurrence-constraints "["))
 	  (loop for occurrencetype-topic in occurrencetype-topics
 	     do (let ((constraint-lists
 		       (remove-duplicate-constraints
-			(loop for topicoccurrence-constraint in topicoccurrence-constraints
-			   when (eq occurrencetype-topic (getf topicoccurrence-constraint :type))
+			(loop for topicoccurrence-constraint in
+			   topicoccurrence-constraints
+			   when (eq occurrencetype-topic
+				    (getf topicoccurrence-constraint :type))
 			   collect (getf topicoccurrence-constraint :constraint)))))
 		  (let ((contrary-constraints
 			 (find-contrary-constraints constraint-lists)))
 		    (when contrary-constraints
-		      (error "found contrary topicname-constraints: ~a~%" contrary-constraints)))
-
-
+		      (error "found contrary topicname-constraints: ~a~%"
+			     contrary-constraints)))
 		  (let ((occurrencetype-with-subtypes
-			 (getf (list-subtypes occurrencetype-topic occurrencetype occurrencetype-constraint) :subtypes)))
-
+			 (getf
+			  (list-subtypes occurrencetype-topic
+					 occurrencetype occurrencetype-constraint
+					 nil nil revision) :subtypes)))
 		    (let ((occurrencetypes-json-string "\"occurrenceTypes\":["))
 		      (loop for current-topic in occurrencetype-with-subtypes
 			 do (let ((current-json-string
-				   (concatenate 'string "{\"occurrenceType\":" (json-exporter::identifiers-to-json-string current-topic)
-						",\"scopeConstraints\":" (get-typescope-constraints current-topic :what 'topicoccurrence)
-						",\"datatypeConstraint\":" (get-occurrence-datatype-constraint current-topic) "}")))
-			      (setf occurrencetypes-json-string (concatenate 'string occurrencetypes-json-string current-json-string ","))))
-		      
+				   (concatenate
+				    'string "{\"occurrenceType\":"
+				    (json-exporter::identifiers-to-json-string
+				     current-topic :revision revision)
+				    ",\"scopeConstraints\":"
+				    (get-typescope-constraints
+				     current-topic :what 'topicoccurrence
+				     :revision revision)
+				    ",\"datatypeConstraint\":"
+				    (get-occurrence-datatype-constraint
+				     current-topic :revision revision)
+				    "}")))
+			      (setf occurrencetypes-json-string
+				    (concatenate 'string occurrencetypes-json-string
+						 current-json-string ","))))
 		      (if (string= occurrencetypes-json-string "\"occurrenceTypes\"[")
 			  (setf occurrencetypes-json-string "null")
 			  (setf occurrencetypes-json-string
-				(concatenate 'string (subseq occurrencetypes-json-string 0 (- (length occurrencetypes-json-string) 1)) "]")))
+				(concatenate
+				 'string (subseq occurrencetypes-json-string 0
+						 (- (length
+						     occurrencetypes-json-string) 1))
+				 "]")))
 		      (let ((unique-constraints
 			     (concatenate 'string "\"uniqueConstraints\":"
-					  (get-simple-constraints unique-constraint-topics)))
+					  (get-simple-constraints
+					   unique-constraint-topics
+					   :revision revision)))
 			    (json-constraint-lists
-			     (concatenate 'string "\"constraints\":" (simple-constraints-to-json constraint-lists))))
+			     (concatenate
+			      'string "\"constraints\":" 
+			      (simple-constraints-to-json constraint-lists))))
 			(let ((current-json-string
-			       (concatenate 'string "{" occurrencetypes-json-string "," json-constraint-lists "," unique-constraints "}")))
+			       (concatenate
+				'string "{" occurrencetypes-json-string ","
+				json-constraint-lists "," unique-constraints "}")))
 			  (setf cleaned-topicoccurrence-constraints
-				(concatenate 'string cleaned-topicoccurrence-constraints current-json-string ","))))))))
+				(concatenate
+				 'string cleaned-topicoccurrence-constraints
+				 current-json-string ","))))))))
 	  (if (string= cleaned-topicoccurrence-constraints "[")
 	      (setf cleaned-topicoccurrence-constraints "null")
 	      (setf cleaned-topicoccurrence-constraints
-		    (concatenate 'string (subseq cleaned-topicoccurrence-constraints 0 (- (length cleaned-topicoccurrence-constraints) 1)) "]")))
+		    (concatenate
+		     'string
+		     (subseq
+		      cleaned-topicoccurrence-constraints 0
+		      (- (length cleaned-topicoccurrence-constraints) 1)) "]")))
 	  cleaned-topicoccurrence-constraints)))))
 
 
-(defun get-occurrence-datatype-constraint(occurrencetype-topic)
+(defun get-occurrence-datatype-constraint(occurrencetype-topic
+					  &key (revision *TM-REVISION*))
   "Return a datatype qualifier as a string."
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(occurrencetype-role (get-item-by-psi *occurrencetype-role-psi*))
-	(datatype (get-item-by-psi *datatype-psi*))
-	(occurrencedatatype-constraint (get-item-by-psi *occurrencedatatype-constraint-psi*)))
+  (declare (TopicC occurrencetype-topic)
+	   (type (or integer null) revision))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(occurrencetype-role (get-item-by-psi *occurrencetype-role-psi*
+					      :revision revision))
+	(datatype (get-item-by-psi *datatype-psi* :revision revision))
+	(occurrencedatatype-constraint
+	 (get-item-by-psi *occurrencedatatype-constraint-psi*
+			  :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (get-item-by-psi *topictype-constraint-psi*
+					       :revision revision)))
     (let ((datatype-constraints
 	   (remove-duplicates
-	    (loop for role in (player-in-roles occurrencetype-topic)
-	       when (and (eq occurrencetype-role (instance-of role))
-			 (eq applies-to (instance-of (parent role))))
-	       append (loop for other-role in (roles (parent role))
-			 when (and (eq constraint-role (instance-of other-role))
-				   (topictype-of-p (player other-role) occurrencedatatype-constraint))
-			 collect (player other-role))))))
+	    (loop for role in (player-in-roles occurrencetype-topic :revision revision)
+	       when (and (eq occurrencetype-role (instance-of role :revision revision))
+			 (eq applies-to (instance-of (parent role :revision revision)
+						     :revision revision)))
+	       append (loop for other-role in (roles (parent role :revision revision)
+						     :revision revision)
+			 when (and (eq constraint-role
+				       (instance-of other-role :revision revision))
+				   (topictype-of-p
+				    (player other-role :revision revision)
+				    occurrencedatatype-constraint topictype
+				    topictype-constraint nil revision))
+			 collect (player other-role :revision revision))))))
       (let ((datatype-constraint
 	     (remove-duplicates
-	      (map 'list #'(lambda(constraint-topic)
-			     (loop for occurrence in (occurrences constraint-topic)
-				when (and (eq (instance-of occurrence) datatype)
-					  (slot-boundp occurrence 'charvalue))
-				return (charvalue occurrence)))
-		   datatype-constraints))))
+	      (map
+	       'list
+	       #'(lambda(constraint-topic)
+		   (loop for occurrence in
+			(occurrences constraint-topic :revision revision)
+		      when (and (eq (instance-of occurrence :revision revision)
+				    datatype)
+				(slot-boundp occurrence 'charvalue))
+		      return (charvalue occurrence)))
+	       datatype-constraints))))
 	(when (> (length datatype-constraint) 1)
-	  (error "found contrary occurrence-datatype-constraints: ~a~%" datatype-constraints))
+	  (error "found contrary occurrence-datatype-constraints: ~a~%"
+		 datatype-constraints))
 	(if datatype-constraint
 	    (json:encode-json-to-string (first datatype-constraint))
 	    "null")))))
 
 
-(defun get-typescope-constraints(element-type-topic &key(what 'topicname))
+(defun get-typescope-constraints(element-type-topic &key (what 'topicname)
+				 (revision *TM-REVISION*))
   "Returns a list of scopes for the element-typetopic which is the type topic of
    a topicname, a topicoccurrence or an association. To specifiy of what kind
    of element the scopes should be there is the key-variable what.
@@ -706,116 +1071,175 @@
    [{scopeTypes:[[[psi-1-1, psi-1-2], [subtype-1-psi-1, subtype-1-psi-2]], [[psi-2-1],
    [subtype-1-psi-1], [subtype-2-psi-1]]], cardMin: <int-as-string>,
    cardMax <int-as-string | MAX_INT>}, <...>]."
+  (declare (TopicC element-type-topic)
+	   (symbol what)
+	   (type (or integer null) revision))
   (let ((element-type-role-and-scope-constraint
 	 (cond
 	   ((eq what 'topicname)
-	    (list (get-item-by-psi *nametype-role-psi*)
-		  (get-item-by-psi *nametypescope-constraint-psi*)))
+	    (list (get-item-by-psi *nametype-role-psi* :revision revision)
+		  (get-item-by-psi *nametypescope-constraint-psi*
+				   :revision revision)))
 	   ((eq what 'topicoccurrence)
 	    (list
-	     (get-item-by-psi *occurrencetype-role-psi*)
-	     (get-item-by-psi *occurrencetypescope-constraint-psi*)))
+	     (get-item-by-psi *occurrencetype-role-psi* :revision revision)
+	     (get-item-by-psi *occurrencetypescope-constraint-psi*
+			      :revision revision)))
 	   ((eq what 'association)
 	    (list
-	     (get-item-by-psi *associationtype-role-psi*)
-	     (get-item-by-psi *associationtypescope-constraint-psi*)))))
-	(scopetype-role (get-item-by-psi *scopetype-role-psi*))
-	(constraint-role (get-item-by-psi *constraint-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(scopetype (get-item-by-psi *scopetype-psi*)))
+	     (get-item-by-psi *associationtype-role-psi* :revision revision)
+	     (get-item-by-psi *associationtypescope-constraint-psi*
+			      :revision revision)))))
+	(scopetype-role (get-item-by-psi *scopetype-role-psi* :revision revision))
+	(constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(scopetype (get-item-by-psi *scopetype-psi* :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (get-item-by-psi *topictype-constraint-psi*
+					       :revision revision)))
     (when (and (= (length element-type-role-and-scope-constraint) 2)
 	       (first element-type-role-and-scope-constraint)
 	       (second element-type-role-and-scope-constraint))
       (let ((type-role (first element-type-role-and-scope-constraint))
 	    (typescope-constraint (second element-type-role-and-scope-constraint)))
 	(let ((typescope-constraints
-	       (loop for role in (player-in-roles element-type-topic)
-		  when (and (eq type-role (instance-of role))
-			    (eq applies-to (instance-of (parent role))))
-		  append (loop for other-role in (roles (parent role))
-			    when (and (eq constraint-role (instance-of other-role))
-				      (topictype-of-p (player other-role) typescope-constraint))
-			    collect (let ((scopes nil)
-					  (constraint nil))
-				      (loop for c-role in (player-in-roles (player other-role))
-					 when (and (eq constraint-role (instance-of c-role))
-						   (eq applies-to (instance-of (parent c-role))))
-					 do (progn
-					      (setf constraint (get-constraint-topic-values (player c-role)))
-					      (loop for c-other-role in (roles (parent c-role))
-						 when (eq scopetype-role (instance-of c-other-role))
-						 do (push (player c-other-role) scopes))))
-				      (list :scopes scopes :constraint constraint))))))
+	       (loop for role in
+		    (player-in-roles element-type-topic :revision revision)
+		  when (and (eq type-role (instance-of role :revision revision))
+			    (eq applies-to
+				(instance-of (parent role :revision revision)
+					     :revision revision)))
+		  append
+		    (loop for other-role in
+			 (roles (parent role :revision revision)
+				:revision revision)
+		       when (and (eq constraint-role
+				     (instance-of other-role :revision revision))
+				 (topictype-of-p
+				  (player other-role :revision revision)
+				  typescope-constraint topictype
+				  topictype-constraint nil revision))
+		       collect
+			 (let ((scopes nil)
+			       (constraint nil))
+			   (loop for c-role in
+				(player-in-roles
+				 (player other-role :revision revision)
+				 :revision revision)
+			      when (and (eq constraint-role
+					    (instance-of c-role :revision revision))
+					(eq applies-to
+					    (instance-of
+					     (parent c-role :revision revision)
+					     :revision revision)))
+			      do (progn
+				   (setf constraint
+					 (get-constraint-topic-values
+					  (player c-role :revision revision)
+					  :revision revision))
+				   (loop for c-other-role in
+					(roles (parent c-role :revision revision)
+					       :revision revision)
+				      when (eq scopetype-role
+					       (instance-of c-other-role
+							    :revision revision))
+				      do (push
+					  (player c-other-role :revision revision)
+					  scopes))))
+			   (list :scopes scopes :constraint constraint))))))
 	  (let ((scopetype-groups
-		 (remove-duplicates (map 'list #'(lambda(x)
-						   (let ((scopes (getf x :scopes)))
-						     (when scopes
-						       scopes)))
-					 typescope-constraints)
-				    :test #'(lambda(x y)
-					      (when (and (= (length x) (length y))
-							 (= (length x) (length (intersection x y))))
-						t)))))
+		 (remove-duplicates
+		  (map 'list #'(lambda(x)
+				 (let ((scopes (getf x :scopes)))
+				   (when scopes
+				     scopes)))
+		       typescope-constraints)
+		  :test #'(lambda(x y)
+			    (when (and (= (length x) (length y))
+				       (= (length x) (length (intersection x y))))
+			      t)))))
 	    (let ((cleaned-typescope-constraints "["))
 	      (loop for scopetype-group in scopetype-groups
 		 do (let ((constraint-lists
 			   (remove-duplicate-constraints
 			    (loop for typescope-constraint in typescope-constraints
-			       when (and (= (length (getf typescope-constraint :scopes))
-					    (length scopetype-group))
-					 (= (length (getf typescope-constraint :scopes))
-					    (length (intersection (getf typescope-constraint :scopes) scopetype-group))))
+			       when
+				 (and (= (length (getf typescope-constraint :scopes))
+					 (length scopetype-group))
+				      (= (length (getf typescope-constraint :scopes))
+					 (length (intersection
+						  (getf typescope-constraint :scopes)
+						  scopetype-group))))
 			       collect (getf typescope-constraint :constraint)))))
 		      (when (> (length constraint-lists) 1)
 			(error "found contrary scopetype-constraints for ~a: ~a~%"
-			       (map 'list #'(lambda(x)(uri (first (psis x)))) scopetype-group)
+			       (map 'list
+				    #'(lambda(x)
+					(uri (first (psis x :revision revision))))
+				    scopetype-group)
 			       constraint-lists))
 		      (let ((card-min (getf (first constraint-lists) :card-min))
 			    (card-max (getf (first constraint-lists) :card-max)))
 			(let ((json-scopes
-			       (concatenate 'string "\"scopeTypes\":"
-			  
-					    (let ((scopetypes-with-subtypes
-						   (remove-if #'null
-						    (loop for current-scopetype in scopetype-group
-						       collect (getf (list-subtypes current-scopetype scopetype nil) :subtypes)))))
-					      
-					      (json:encode-json-to-string
-					       (map 'list #'(lambda(topic-group)
-							      (map 'list #'(lambda(topic)
-									     (map 'list #'uri (psis topic)))
-								   topic-group))
-						    scopetypes-with-subtypes))))))
+			       (concatenate
+				'string "\"scopeTypes\":"
+				(let ((scopetypes-with-subtypes
+				       (remove-if
+					#'null
+					(loop for current-scopetype in scopetype-group
+					   collect (getf
+						    (list-subtypes current-scopetype
+								   scopetype nil nil
+								   nil revision)
+						    :subtypes)))))
+				  (json:encode-json-to-string
+				   (map
+				    'list
+				    #'(lambda(topic-group)
+					(map 'list
+					     #'(lambda(topic)
+						 (map 'list #'uri
+						      (psis topic :revision revision)))
+					     topic-group))
+				    scopetypes-with-subtypes))))))
 			  (let ((current-json-string
-				 (concatenate 'string "{" json-scopes ",\"cardMin\":\"" card-min "\",\"cardMax\":\"" card-max "\"}")))
+				 (concatenate 'string "{" json-scopes
+					      ",\"cardMin\":\"" card-min
+					      "\",\"cardMax\":\"" card-max "\"}")))
 			    (setf cleaned-typescope-constraints 
-				  (concatenate 'string cleaned-typescope-constraints current-json-string ",")))))))
+				  (concatenate 'string cleaned-typescope-constraints
+					       current-json-string ",")))))))
 	      (if (string= cleaned-typescope-constraints "[")
 		  (setf cleaned-typescope-constraints "null")
 		  (setf cleaned-typescope-constraints 
-			(concatenate 'string (subseq cleaned-typescope-constraints 0 (- (length cleaned-typescope-constraints) 1)) "]")))
+			(concatenate
+			 'string
+			 (subseq cleaned-typescope-constraints 0
+				 (- (length cleaned-typescope-constraints) 1)) "]")))
 	      cleaned-typescope-constraints)))))))
     
 
 ;; =============================================================================
 ;; --- some basic helpers ------------------------------------------------------
 ;; =============================================================================
-(defun get-constraint-topic-values(topic)
+(defun get-constraint-topic-values(topic &key (revision *TM-REVISION*))
   "Returns all constraint values of the passed topic in the
    following form (list :regexp regexp :card-min card-min :card-max card-max)"
+  (declare (type (or integer null) revision))
   (let ((regexp
-	 (get-constraint-occurrence-value topic))
+	 (get-constraint-occurrence-value topic :revision revision))
 	(card-min
-	 (get-constraint-occurrence-value topic :what 'card-min))
+	 (get-constraint-occurrence-value topic :what 'card-min :revision revision))
 	(card-max
-	 (get-constraint-occurrence-value topic :what 'card-max)))
+	 (get-constraint-occurrence-value topic :what 'card-max :revision revision)))
     (when (and (string/= "MAX_INT" card-max)
 	       (> (parse-integer card-min) (parse-integer card-max)))
       (error "card-min (~a) must be < card-max (~a)" card-min card-max))
     (list :regexp regexp :card-min card-min :card-max card-max)))
 
 
-(defun get-constraint-occurrence-value(topic &key (what 'regexp))
+(defun get-constraint-occurrence-value(topic &key (what 'regexp)
+				       (revision *TM-REVISION*))
   "Checks the occurrence-value of a regexp, card-min or card-max
    constraint-occurrence.
    If what = 'regexp and the occurrence-value is empty there will be returned
@@ -824,6 +1248,9 @@
    the value '0'.
    If what = 'card-max and the occurrence-value is empty there will be returned
    the value 'MAX_INT'"
+  (declare (type (or integer null) revision)
+	   (TopicC topic)
+	   (symbol what))
   (let ((occurrence-type
 	 (get-item-by-psi
 	  (cond 
@@ -834,11 +1261,14 @@
 	    ((eq what 'card-max)
 	     *card-max-psi*)
 	    (t
-	     "")))))
+	     ""))
+	  :revision revision)))
     (when occurrence-type
       (let ((occurrence-value
 	     (let ((occurrence
-		    (find occurrence-type (occurrences topic) :key #'instance-of)))
+		    (find occurrence-type (occurrences topic :revision revision)
+			  :key #'(lambda(occ)
+				   (instance-of occ :revision revision)))))
 	       (if (and occurrence
 			(slot-boundp occurrence 'charvalue)
 			(> (length  (charvalue occurrence)) 0))
@@ -860,7 +1290,7 @@
 		    (condition () nil))))
 	     (unless is-valid
 	       (error "card-min in ~a is \"~a\" but should be >= 0"
-		      (uri (first (psis topic)))
+		      (uri (first (psis topic :revision revision)))
 		      occurrence-value))))
 	  ((eq what 'card-max)
 	   (let ((is-valid
@@ -887,9 +1317,14 @@
        do (progn
 	    (when (> (length current-constraint) 0)
 	      (return-from find-contrary-constraints current-constraint))
-	    (setf current-constraint (remove-if #'null (map 'list #'(lambda(x)
-								      (contrary-constraint-list x constraint-list))
-							    constraint-lists)))))))
+	    (setf current-constraint
+		  (remove-if
+		   #'null
+		   (map 'list
+			#'(lambda(x)
+			    (contrary-constraint-list x constraint-list))
+			constraint-lists)))))))
+
 
 (defun contrary-constraint-list (lst-1 lst-2)
   "Returns both passed lists when they have the same
@@ -911,7 +1346,6 @@
   (remove-duplicates constraint-lists :test #'eql-constraint-list))
 
 
-
 (defun eql-constraint-list (lst-1 lst-2)
   "Compares two constraint lists of the form (list <string> <string> string>)
    or (list <topic> <string> <string> <string>."
@@ -923,20 +1357,35 @@
 
 
 ;; --- gets all constraint topics ----------------------------------------------
-(defun get-direct-constraint-topics-of-topic (topic-instance)
+(defun get-direct-constraint-topics-of-topic (topic-instance &key
+					      (revision *TM-REVISION*))
   "Returns all constraint topics defined for the passed topic-instance"
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(topictype-role (get-item-by-psi *topictype-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(abstract-topictype-constraint (get-item-by-psi *abstract-topictype-constraint-psi*))
-	(exclusive-instance-constraint (get-item-by-psi *exclusive-instance-psi*))
-	(subjectidentifier-constraint (get-item-by-psi *subjectidentifier-constraint-psi*))
-	(subjectlocator-constraint (get-item-by-psi *subjectlocator-constraint-psi*))
-	(topicname-constraint (get-item-by-psi *topicname-constraint-psi*))
-	(topicoccurrence-constraint (get-item-by-psi *topicoccurrence-constraint-psi*))
-	(uniqueoccurrence-constraint (get-item-by-psi *uniqueoccurrence-constraint-psi*))
-	(roleplayer-constraint (get-item-by-psi *roleplayer-constraint-psi*))
-	(otherrole-constraint (get-item-by-psi *otherrole-constraint-psi*))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(topictype-role (get-item-by-psi *topictype-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(abstract-topictype-constraint
+	 (get-item-by-psi *abstract-topictype-constraint-psi* :revision revision))
+	(exclusive-instance-constraint
+	 (get-item-by-psi *exclusive-instance-psi* :revision revision))
+	(subjectidentifier-constraint
+	 (get-item-by-psi *subjectidentifier-constraint-psi* :revision revision))
+	(subjectlocator-constraint
+	 (get-item-by-psi *subjectlocator-constraint-psi* :revision revision))
+	(topicname-constraint
+	 (get-item-by-psi *topicname-constraint-psi* :revision revision))
+	(topicoccurrence-constraint
+	 (get-item-by-psi *topicoccurrence-constraint-psi* :revision revision))
+	(uniqueoccurrence-constraint
+	 (get-item-by-psi *uniqueoccurrence-constraint-psi* :revision revision))
+	(roleplayer-constraint
+	 (get-item-by-psi *roleplayer-constraint-psi* :revision revision))
+	(otherrole-constraint
+	 (get-item-by-psi *otherrole-constraint-psi* :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (get-item-by-psi *topictype-constraint-psi*
+					       :revision revision))
 	(abstract-topictype-constraints nil)
 	(exclusive-instance-constraints nil)
 	(subjectidentifier-constraints nil)
@@ -944,35 +1393,51 @@
 	(topicname-constraints nil)
 	(topicoccurrence-constraints nil)
 	(uniqueoccurrence-constraints nil))
-
-    (loop for role in (player-in-roles topic-instance)
-       when (and (eq topictype-role (instance-of role))
-		 (eq applies-to (instance-of (parent role))))
-       do (loop for other-role in (roles (parent role))
-	     when (eq constraint-role (instance-of other-role))
-	     do (let ((constraint-topic (player other-role)))
+    (loop for role in (player-in-roles topic-instance :revision revision)
+       when (and (eq topictype-role (instance-of role :revision revision))
+		 (eq applies-to (instance-of (parent role :revision revision)
+					     :revision revision)))
+       do (loop for other-role in (roles (parent role :revision revision)
+					 :revision revision)
+	     when (eq constraint-role (instance-of other-role :revision revision))
+	     do (let ((constraint-topic (player other-role :revision revision)))
 		  (cond
-		    ((topictype-of-p constraint-topic abstract-topictype-constraint)
+		    ((topictype-of-p constraint-topic abstract-topictype-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic abstract-topictype-constraints))
-		    ((topictype-of-p constraint-topic exclusive-instance-constraint)
+		    ((topictype-of-p constraint-topic exclusive-instance-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic exclusive-instance-constraints))
-		    ((topictype-of-p constraint-topic subjectidentifier-constraint)
+		    ((topictype-of-p constraint-topic subjectidentifier-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic subjectidentifier-constraints))
-		    ((topictype-of-p constraint-topic subjectlocator-constraint)
+		    ((topictype-of-p constraint-topic subjectlocator-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic subjectlocator-constraints))
-		    ((topictype-of-p constraint-topic topicname-constraint)
+		    ((topictype-of-p constraint-topic topicname-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic topicname-constraints))
-		    ((topictype-of-p constraint-topic topicoccurrence-constraint)
+		    ((topictype-of-p constraint-topic topicoccurrence-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic topicoccurrence-constraints))
-		    ((topictype-of-p constraint-topic uniqueoccurrence-constraint)
+		    ((topictype-of-p constraint-topic uniqueoccurrence-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic uniqueoccurrence-constraints))
 		    (t
-		     (unless (or (topictype-of-p constraint-topic roleplayer-constraint)
-				 (topictype-of-p constraint-topic otherrole-constraint))
-		      (error "Constraint-Topic \"~a\" could not be handled" (uri (first (psis constraint-topic))))))))))
+		     (unless (or
+			      (topictype-of-p constraint-topic roleplayer-constraint
+					      topictype topictype-constraint
+					      nil revision)
+			      (topictype-of-p constraint-topic otherrole-constraint
+					      topictype topictype-constraint
+					      nil revision))
+		       (error "Constraint-Topic \"~a\" could not be handled"
+			      (uri (first (psis constraint-topic
+						:revision revision))))))))))
     (list :abstract-topictype-constraints abstract-topictype-constraints
-	  :exclusive-instance-constraints (list :exclusive-constraints exclusive-instance-constraints
-						:owner topic-instance)
+	  :exclusive-instance-constraints
+	  (list :exclusive-constraints exclusive-instance-constraints
+		:owner topic-instance)
 	  :subjectidentifier-constraints subjectidentifier-constraints
 	  :subjectlocator-constraints subjectlocator-constraints
 	  :topicname-constraints topicname-constraints
@@ -980,7 +1445,8 @@
 	  :uniqueoccurrence-constraints uniqueoccurrence-constraints)))
 
 
-(defun get-all-constraint-topics-of-topic (topic-instance &key (treat-as 'type))
+(defun get-all-constraint-topics-of-topic (topic-instance &key (treat-as 'type)
+					   (revision *TM-REVISION*))
   "Returns a list of constraint-topics of the topics-instance's base type(s).
    If topic c is instanceOf a and b, there will be returned all
    constraint-topics of the topic types a and b.
@@ -988,112 +1454,157 @@
    defined for the supertypes or the types of the passed topic - all constraints
    defined directly for the passed topic are ignored, unless the passed topic is
    an instance of itself."
-  (let ((akos-and-isas-of-this
-	 (remove-duplicates
-	  (if (eql treat-as 'type)
-	      (progn
-		(topictype-p topic-instance)
-		(get-all-upper-constrainted-topics topic-instance))
-	      (progn
-		(valid-instance-p topic-instance)
-		(let ((topictypes
-		       (get-direct-types-of-topic topic-instance))
-		      (all-constraints nil))
-		  (dolist (tt topictypes)
-		    (let ((upts
-			   (get-all-upper-constrainted-topics tt)))
-		      (dolist (upt upts)
-			(pushnew upt all-constraints))))
-		  (remove-if #'(lambda(x)
-				 (when (eql x topic-instance)
-				   t))
-			     all-constraints)))))))
-		      
-    (let ((all-abstract-topictype-constraints nil)
-	  (all-exclusive-instance-constraints nil)
-	  (all-subjectidentifier-constraints nil)
-	  (all-subjectlocator-constraints nil)
-	  (all-topicname-constraints nil)
-	  (all-topicoccurrence-constraints nil)
-	  (all-uniqueoccurrence-constraints nil))
-      (loop for topic in akos-and-isas-of-this
-	 do (let ((constraint-topics-of-topic (get-direct-constraint-topics-of-topic topic)))
-	      (when (eq topic topic-instance)
-		(dolist (item (getf constraint-topics-of-topic :abstract-topictype-constraints))
-		  (pushnew item all-abstract-topictype-constraints)))
-	      (let ((exclusive-instance-constraints
-		     (getf constraint-topics-of-topic :exclusive-instance-constraints)))
-		(when (getf exclusive-instance-constraints :exclusive-constraints)
-		  (push exclusive-instance-constraints all-exclusive-instance-constraints)))
-	      (dolist (item (getf constraint-topics-of-topic :subjectidentifier-constraints))
-		(pushnew item all-subjectidentifier-constraints))
-	      (dolist (item (getf constraint-topics-of-topic :subjectlocator-constraints))
-		(pushnew item all-subjectlocator-constraints))
-	      (dolist (item (getf constraint-topics-of-topic :topicname-constraints))
-		(pushnew item all-topicname-constraints))
-	      (dolist (item (getf constraint-topics-of-topic :topicoccurrence-constraints))
-		(pushnew item all-topicoccurrence-constraints))
-	      (dolist (item (getf constraint-topics-of-topic :uniqueoccurrence-constraints))
-		(pushnew item all-uniqueoccurrence-constraints))))
-      (list :abstract-topictype-constraints all-abstract-topictype-constraints
-	    :exclusive-instance-constraints all-exclusive-instance-constraints
-	    :subjectidentifier-constraints all-subjectidentifier-constraints
-	    :subjectlocator-constraints all-subjectlocator-constraints
-	    :topicname-constraints all-topicname-constraints
-	    :topicoccurrence-constraints all-topicoccurrence-constraints
-	    :uniqueoccurrence-constraints all-uniqueoccurrence-constraints))))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (symbol treat-as))
+  (let ((topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (get-item-by-psi *topictype-constraint-psi*
+					       :revision revision)))
+    (let ((akos-and-isas-of-this
+	   (remove-duplicates
+	    (if (eql treat-as 'type)
+		(progn
+		  (topictype-p topic-instance topictype topictype-constraint
+			       nil revision)
+		  (get-all-upper-constrainted-topics topic-instance
+						     :revision revision))
+		(progn
+		  (valid-instance-p topic-instance nil nil revision)
+		  (let ((topictypes
+			 (get-direct-types-of-topic topic-instance
+						    :revision revision))
+			(all-constraints nil))
+		    (dolist (tt topictypes)
+		      (let ((upts
+			     (get-all-upper-constrainted-topics tt
+								:revision revision)))
+			(dolist (upt upts)
+			  (pushnew upt all-constraints))))
+		    (remove-if #'(lambda(x)
+				   (when (eql x topic-instance)
+				     t))
+			       all-constraints)))))))
+      (let ((all-abstract-topictype-constraints nil)
+	    (all-exclusive-instance-constraints nil)
+	    (all-subjectidentifier-constraints nil)
+	    (all-subjectlocator-constraints nil)
+	    (all-topicname-constraints nil)
+	    (all-topicoccurrence-constraints nil)
+	    (all-uniqueoccurrence-constraints nil))
+	(loop for topic in akos-and-isas-of-this
+	   do (let ((constraint-topics-of-topic
+		     (get-direct-constraint-topics-of-topic topic
+							    :revision revision)))
+		(when (eq topic topic-instance)
+		  (dolist (item (getf constraint-topics-of-topic
+				      :abstract-topictype-constraints))
+		    (pushnew item all-abstract-topictype-constraints)))
+		(let ((exclusive-instance-constraints
+		       (getf constraint-topics-of-topic
+			     :exclusive-instance-constraints)))
+		  (when (getf exclusive-instance-constraints :exclusive-constraints)
+		    (push exclusive-instance-constraints
+			  all-exclusive-instance-constraints)))
+		(dolist (item (getf constraint-topics-of-topic
+				    :subjectidentifier-constraints))
+		  (pushnew item all-subjectidentifier-constraints))
+		(dolist (item (getf constraint-topics-of-topic
+				    :subjectlocator-constraints))
+		  (pushnew item all-subjectlocator-constraints))
+		(dolist (item (getf constraint-topics-of-topic
+				    :topicname-constraints))
+		  (pushnew item all-topicname-constraints))
+		(dolist (item (getf constraint-topics-of-topic
+				    :topicoccurrence-constraints))
+		  (pushnew item all-topicoccurrence-constraints))
+		(dolist (item (getf constraint-topics-of-topic
+				    :uniqueoccurrence-constraints))
+		  (pushnew item all-uniqueoccurrence-constraints))))
+	(list :abstract-topictype-constraints all-abstract-topictype-constraints
+	      :exclusive-instance-constraints all-exclusive-instance-constraints
+	      :subjectidentifier-constraints all-subjectidentifier-constraints
+	      :subjectlocator-constraints all-subjectlocator-constraints
+	      :topicname-constraints all-topicname-constraints
+	      :topicoccurrence-constraints all-topicoccurrence-constraints
+	      :uniqueoccurrence-constraints all-uniqueoccurrence-constraints)))))
 
 
-(defun get-direct-constraint-topics-of-association(associationtype-topic)
+(defun get-direct-constraint-topics-of-association(associationtype-topic
+						   &key (revision *TM-REVISION*))
   "Returns all direct constraint topics defined for associations if
    the passed associationtype-topic"
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(associationtype-role (get-item-by-psi *associationtype-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(associationtypescope-constraint (get-item-by-psi *associationtypescope-constraint-psi*))
-	(associationrole-constraint (get-item-by-psi *associationrole-constraint-psi*))
-	(roleplayer-constraint (get-item-by-psi *roleplayer-constraint-psi*))
-	(otherrole-constraint (get-item-by-psi *otherrole-constraint-psi*))
+  (declare (type (or integer null) revision)
+	   (TopicC associationtype-topic))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(associationtype-role (get-item-by-psi *associationtype-role-psi*
+					       :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(associationtypescope-constraint
+	 (get-item-by-psi *associationtypescope-constraint-psi* :revision revision))
+	(associationrole-constraint (get-item-by-psi *associationrole-constraint-psi*
+						     :revision revision))
+	(roleplayer-constraint (get-item-by-psi *roleplayer-constraint-psi*
+						:revision revision))
+	(otherrole-constraint (get-item-by-psi *otherrole-constraint-psi*
+					       :revision revision))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (get-item-by-psi *topictype-constraint-psi*
+					       :revision revision))
 	(associationrole-constraints nil)
 	(roleplayer-constraints nil)
 	(otherrole-constraints nil))
-
-    (loop for role in (player-in-roles associationtype-topic)
-       when (and (eq associationtype-role (instance-of role))
-		 (eq applies-to (instance-of (parent role))))
-       do (loop for other-role in (roles (parent role))
-	     when (eq constraint-role (instance-of other-role))
-	     do (let ((constraint-topic (player other-role)))
+    (loop for role in (player-in-roles associationtype-topic :revision revision)
+       when (and (eq associationtype-role (instance-of role :revision revision))
+		 (eq applies-to (instance-of (parent role :revision revision)
+					     :revision revision)))
+       do (loop for other-role in (roles (parent role :revision revision)
+					 :revision revision)
+	     when (eq constraint-role (instance-of other-role :revision revision))
+	     do (let ((constraint-topic (player other-role :revision revision)))
 		  (cond
-		    ((topictype-of-p constraint-topic associationtypescope-constraint)
+		    ((topictype-of-p constraint-topic associationtypescope-constraint
+				     topictype topictype-constraint nil revision)
 		     t) ;do nothing
-		    ((topictype-of-p constraint-topic associationrole-constraint)
+		    ((topictype-of-p constraint-topic associationrole-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic associationrole-constraints))
-		    ((topictype-of-p constraint-topic roleplayer-constraint)
+		    ((topictype-of-p constraint-topic roleplayer-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic roleplayer-constraints))
-		    ((topictype-of-p constraint-topic otherrole-constraint)
+		    ((topictype-of-p constraint-topic otherrole-constraint
+				     topictype topictype-constraint nil revision)
 		     (pushnew constraint-topic otherrole-constraints))
 		    (t
-		     (error "Constraint-Topic \"~a\" could not be handled" (uri (first (psis constraint-topic)))))))))
-
+		     (error "Constraint-Topic \"~a\" could not be handled"
+			    (uri (first (psis constraint-topic
+					      :revision revision)))))))))
     (list :associationrole-constraints associationrole-constraints
 	  :roleplayer-constraints roleplayer-constraints
 	  :otherrole-constraints otherrole-constraints)))
 
 
-(defun get-all-constraint-topics-of-association(associationtype-topic)
+(defun get-all-constraint-topics-of-association(associationtype-topic &key
+						(revision *TM-REVISION*))
   "Returns all constraint topics defined for associations if
    the passed associationtype-topic."
-  (topictype-p associationtype-topic (get-item-by-psi *associationtype-psi*) (is-type-constrained :what *associationtype-constraint-psi*))
+  (declare (type (or integer null) revision)
+	   (TopicC associationtype-topic))
+  (topictype-p associationtype-topic
+	       (get-item-by-psi *associationtype-psi* :revision revision)
+	       (is-type-constrained :what *associationtype-constraint-psi*
+				    :revision revision) nil revision)
   (let ((akos-and-isas-of-this
-	 (get-all-upper-constrainted-topics associationtype-topic)))
+	 (get-all-upper-constrainted-topics associationtype-topic
+					    :revision revision)))
     (let ((all-associationrole-constraints nil)
 	  (all-roleplayer-constraints nil)
 	  (all-otherrole-constraints nil))
       (loop for topic in akos-and-isas-of-this
 	 do (let ((constraint-topics-of-topic
-		   (get-direct-constraint-topics-of-association topic)))
-	      (dolist (item (getf constraint-topics-of-topic :associationrole-constraints))
+		   (get-direct-constraint-topics-of-association topic
+								:revision revision)))
+	      (dolist (item (getf constraint-topics-of-topic
+				  :associationrole-constraints))
 		(pushnew item all-associationrole-constraints))
 	      (dolist (item (getf constraint-topics-of-topic :roleplayer-constraints))
 		(pushnew item all-roleplayer-constraints))
@@ -1104,105 +1615,172 @@
 	    :otherrole-constraints all-otherrole-constraints))))
 
 
-(defun get-available-associations-of-topic(topic-instance &key (treat-as 'type))
+(defun get-available-associations-of-topic(topic-instance &key (treat-as 'type)
+					   (revision *TM-REVISION*))
   "Returns a list of topics decribing the available associationtype for the
    passed topic."
-  (let ((applies-to (get-item-by-psi *applies-to-psi*))
-	(topictype-role (get-item-by-psi *topictype-role-psi*))
-	(constraint-role (get-item-by-psi *constraint-role-psi*))
-	(othertopictype-role (get-item-by-psi *othertopictype-role-psi*))
-	(associationtype-role (get-item-by-psi *associationtype-role-psi*))
-	(associationtype (get-item-by-psi *associationtype-psi*))
-	(associationtype-constraint (get-item-by-psi *associationtype-constraint-psi*))
-	(roleplayer-constraint (get-item-by-psi *roleplayer-constraint-psi*))
-	(otherrole-constraint (get-item-by-psi *otherrole-constraint-psi*))
-	(all-possible-player-topics	 
-	 (remove-duplicates
-	  (if (eql treat-as 'type)
-	      (topictype-p topic-instance)
-	      (valid-instance-p topic-instance)))))
-    (let ((all-available-associationtypes
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (symbol treat-as))
+  (let ((topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (get-item-by-psi *topictype-constraint-psi*
+					       :revision revision)))
+    (let ((applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	  (topictype-role (get-item-by-psi *topictype-role-psi* :revision revision))
+	  (constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	  (othertopictype-role (get-item-by-psi *othertopictype-role-psi*
+						:revision revision))
+	  (associationtype-role (get-item-by-psi *associationtype-role-psi*
+						 :revision revision))
+	  (associationtype (get-item-by-psi *associationtype-psi* :revision revision))
+	  (associationtype-constraint
+	   (get-item-by-psi *associationtype-constraint-psi* :revision revision))
+	  (roleplayer-constraint (get-item-by-psi *roleplayer-constraint-psi*
+						  :revision revision))
+	  (otherrole-constraint (get-item-by-psi *otherrole-constraint-psi*
+						 :revision revision))
+	  (all-possible-player-topics	 
 	   (remove-duplicates
-	    (loop for possible-player-topic in all-possible-player-topics
-	       append (loop for role in (player-in-roles possible-player-topic)
-			 when (and (or (eq topictype-role (instance-of role))
-				       (eq othertopictype-role (instance-of role)))
-				   (eq applies-to (instance-of (parent role))))
-			 append (loop for other-role in (roles (parent role))
-				   when (and (eq constraint-role (instance-of other-role))
-					     (or (topictype-of-p (player other-role) roleplayer-constraint)
-						 (topictype-of-p (player other-role) otherrole-constraint)))
-				   append (loop for c-role in (player-in-roles (player other-role))
-					     when (and (eq constraint-role (instance-of c-role))
-						       (eq applies-to (instance-of (parent c-role))))
-					     append (loop for type-role in (roles (parent c-role))
-						       when (eq associationtype-role (instance-of type-role))
-						       append (map 'list #'(lambda(x)
-									     (topictype-p x associationtype associationtype-constraint)
-									     x)
-								   (getf (list-subtypes (player type-role) associationtype associationtype-constraint) :subtypes))))))))))
-      all-available-associationtypes)))
+	    (if (eql treat-as 'type)
+		(topictype-p topic-instance topictype topictype-constraint nil
+			     revision)
+		(valid-instance-p topic-instance nil nil revision)))))
+      (let ((all-available-associationtypes
+	     (remove-duplicates
+	      (loop for possible-player-topic in all-possible-player-topics
+		 append
+		   (loop for role in (player-in-roles possible-player-topic
+						      :revision revision)
+		      when (and (or (eq topictype-role
+					(instance-of role :revision revision))
+				    (eq othertopictype-role
+					(instance-of role :revision revision)))
+				(eq applies-to
+				    (instance-of (parent role :revision revision)
+						 :revision revision)))
+		      append
+			(loop for other-role in
+			     (roles (parent role :revision revision)
+				    :revision revision)
+			   when (and (eq constraint-role
+					 (instance-of other-role :revision revision))
+				     (or (topictype-of-p
+					  (player other-role :revision revision)
+					  roleplayer-constraint topictype
+					  topictype-constraint nil revision)
+					 (topictype-of-p
+					  (player other-role :revision revision)
+					  otherrole-constraint topictype
+					  topictype-constraint nil revision)))
+			   append
+			     (loop for c-role in
+				  (player-in-roles
+				   (player other-role :revision revision)
+				   :revision revision)
+				when (and (eq constraint-role
+					      (instance-of c-role :revision revision))
+					  (eq applies-to
+					      (instance-of (parent c-role
+								   :revision revision)
+							   :revision revision)))
+				append
+				  (loop for type-role in
+				       (roles (parent c-role :revision revision)
+					      :revision revision)
+				     when (eq associationtype-role
+					      (instance-of type-role
+							   :revision revision))
+				     append
+				       (map 
+					'list
+					#'(lambda(x)
+					    (topictype-p x associationtype
+							 associationtype-constraint
+							 nil revision)
+					    x)
+					(getf (list-subtypes
+					       (player type-role :revision revision)
+					       associationtype
+					       associationtype-constraint nil
+					       nil revision) :subtypes))))))))))
+	all-available-associationtypes))))
 
 
-(defun topics-to-json-list (topics)
+(defun topics-to-json-list (topics &key (revision *TM-REVISION*))
   "Returns a json list of psi-lists."
+  (declare (list topics)
+	   (type (or integer null) revision))
   (json:encode-json-to-string 
    (map 'list #'(lambda(topic)
-		  (map 'list #'uri (psis topic)))
+		  (map 'list #'uri (psis topic :revision revision)))
 	topics)))
 
 
 (defun tree-view-to-json-string (tree-views)
   "Returns a full tree-view as json-string."
   (let ((json-string 
-	 (concatenate 'string "["
-		      (if tree-views
-			  (let ((inner-string ""))
-			    (loop for tree-view in tree-views
-			       do (setf inner-string (concatenate 'string inner-string (node-to-json-string tree-view) ",")))
-			    (concatenate 'string (subseq inner-string 0 (- (length inner-string) 1)) "]"))
-			  "null"))))
+	 (concatenate
+	  'string "["
+	  (if tree-views
+	      (let ((inner-string ""))
+		(loop for tree-view in tree-views
+		   do (setf inner-string 
+			    (concatenate 'string inner-string
+					 (node-to-json-string tree-view) ",")))
+		(concatenate 'string (subseq inner-string 0
+					     (- (length inner-string) 1)) "]"))
+	      "null"))))
     json-string))
 
-(defun make-tree-view ()
+
+(defun make-tree-view (&key (revision *TM-REVISION*))
   "Returns a list of the form:
    ((<topictype> (direct-instances) (direc-subtypes)) (<...>));
    -> direct-instances: (<any-topic> (direct-instances) (direct-subtypes))
    -> direct-subtypes: (<any-topic> (direct-instances) (direct-subtypes))"
-  (let ((topictype (d:get-item-by-psi json-tmcl-constants::*topictype-psi*))
-	(topictype-constraint (is-type-constrained)))
+  (declare (type (or integer null) revision))
+  (let ((topictype
+	 (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision)))
     (if topictype-constraint
 	(progn
 	  (unless topictype
 	    (error "From make-tree-view(): The topictype-constraint \"~a\" exists but the topictype \"~a\" is missing!"
-		   json-tmcl-constants::*topictype-constraint-psi* 
-		   json-tmcl-constants::*topictype-psi*))
-	  (list (make-nodes topictype t t)))
+		   *topictype-constraint-psi* 
+		   *topictype-psi*))
+	  (list (make-nodes topictype t t :revision revision)))
 	(let ((tree-roots
-	       (get-all-tree-roots)))
+	       (get-all-tree-roots :revision revision)))
 	  (let ((tree-list
 		 (loop for root in tree-roots
-		    collect (let ((l-is-type
-				   (handler-case (progn
-						   (topictype-p root topictype topictype-constraint)
-						   t)
-				     (Condition () nil)))
-				  (l-is-instance
-				   (handler-case (progn
-						   (valid-instance-p root)
-						   t)
-				     (Condition () nil))))
-			      (make-nodes root l-is-type l-is-instance)))))
+		    collect
+		      (let ((l-is-type
+			     (handler-case
+				 (progn
+				   (topictype-p root topictype topictype-constraint)
+				   t)
+			       (Condition () nil)))
+			    (l-is-instance
+			     (handler-case (progn
+					     (valid-instance-p root nil nil revision)
+					     t)
+			       (Condition () nil))))
+			(make-nodes root l-is-type l-is-instance
+				    :revision revision)))))
 	    tree-list)))))
 
 
-(defun node-to-json-string(node)
+(defun node-to-json-string(node &key (revision *TM-REVISION*))
   "Returns a json-object of the form
    {topic: [<psis>], isType: <bool>, isInstance: <bool>,
     instances: [<nodes>], subtypes: [<nodes>]}."
+  (declare (type (or integer null) revision)
+	   (list node))
   (let ((topic-psis
-	 (concatenate 'string "\"topic\":"
-		      (json:encode-json-to-string (map 'list #'d:uri (d:psis (getf node :topic))))))
+	 (concatenate
+	  'string "\"topic\":"
+	  (json:encode-json-to-string
+	   (map 'list #'d:uri (d:psis (getf node :topic) :revision revision)))))
 	(is-type
 	 (concatenate 'string "\"isType\":"
 		      (if (getf node :is-type)
@@ -1214,95 +1792,130 @@
 			  "true"
 			  "false")))
 	(instances
-	 (concatenate 'string "\"instances\":"
-		      (if (getf node :instances)
-			  (let ((inner-string "["))
-			    (loop for instance-node in (getf node :instances)
-			       do (setf inner-string (concatenate 'string inner-string (node-to-json-string instance-node) ",")))
-			    (concatenate 'string (subseq inner-string 0 (- (length inner-string) 1)) "]"))
-			  "null")))
+	 (concatenate
+	  'string "\"instances\":"
+	  (if (getf node :instances)
+	      (let ((inner-string "["))
+		(loop for instance-node in (getf node :instances)
+		   do (setf inner-string
+			    (concatenate 
+			     'string inner-string
+			     (node-to-json-string instance-node :revision revision)
+			     ",")))
+		(concatenate 'string (subseq inner-string 0
+					     (- (length inner-string) 1)) "]"))
+	      "null")))
 	(subtypes
-	 (concatenate 'string "\"subtypes\":"
-		      (if (getf node :subtypes)
-			  (let ((inner-string "["))
-			    (loop for instance-node in (getf node :subtypes)
-			       do (setf inner-string (concatenate 'string inner-string (node-to-json-string instance-node) ",")))
-			    (concatenate 'string (subseq inner-string 0 (- (length inner-string) 1)) "]"))
-			  "null"))))
-    (concatenate 'string "{" topic-psis "," is-type "," is-instance "," instances "," subtypes"}")))
+	 (concatenate
+	  'string "\"subtypes\":"
+	  (if (getf node :subtypes)
+	      (let ((inner-string "["))
+		(loop for instance-node in (getf node :subtypes)
+		   do (setf inner-string
+			    (concatenate 'string inner-string
+					 (node-to-json-string instance-node
+							      :revision revision)
+					 ",")))
+		(concatenate 'string (subseq inner-string 0
+					     (- (length inner-string) 1)) "]"))
+	      "null"))))
+    (concatenate 'string "{" topic-psis "," is-type "," is-instance "," instances
+		 "," subtypes"}")))
 
 
-(defun make-nodes (topic-instance is-type is-instance)
+(defun make-nodes (topic-instance is-type is-instance &key (revision *TM-REVISION*))
   "Creates a li of nodes.
    A node looks like
-   (:topic <topic> :is-type <bool> :is-instance <bool> :instances <node> :subtypes <nodes>)."
-  (declare (d:TopicC topic-instance))
-  (let ((topictype (d:get-item-by-psi json-tmcl-constants::*topictype-psi*))
-	(topictype-constraint (is-type-constrained)))
+   (:topic <topic> :is-type <bool> :is-instance <bool> :instances <node>
+    :subtypes <nodes>)."
+  (declare (TopicC topic-instance)
+	   (type (or integer null) revision))
+  (let ((topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision)))
     (let ((isas-of-this
-	   (map 'list #'(lambda(z)
-			  (let ((l-is-type
-				 (handler-case (progn
-						 (topictype-p z topictype topictype-constraint)
-						 t)
-				   (Condition () nil)))
-				(l-is-instance
-				 (handler-case (progn
-						 (valid-instance-p z)
-						 t)
-				   (Condition () nil))))
-			    (list :topic z :is-type l-is-type :is-instance l-is-instance)))
+	   (map
+	    'list
+	    #'(lambda(z)
+		(let ((l-is-type
+		       (handler-case
+			   (progn
+			     (topictype-p z topictype topictype-constraint
+					  nil revision)
+			     t)
+			 (Condition () nil)))
+		      (l-is-instance
+		       (handler-case (progn
+				       (valid-instance-p z nil nil revision)
+				       t)
+			 (Condition () nil))))
+		  (list :topic z :is-type l-is-type :is-instance l-is-instance)))
 		(remove-duplicates
 		 (remove-if #'null
-			    (remove-if #'(lambda(x) (when (eql topic-instance x)
-						      t))
-				       (get-direct-instances-of-topic topic-instance))))))
+			    (remove-if
+			     #'(lambda(x) (when (eql topic-instance x)
+					    t))
+			     (get-direct-instances-of-topic topic-instance
+							    :revision revision))))))
 	  (akos-of-this
-	   (map 'list #'(lambda(z)
-			  (let ((l-is-type
-				 (handler-case (progn
-						 (topictype-p z topictype topictype-constraint)
-						 t)
-				   (Condition () nil)))
-				(l-is-instance
-				 (handler-case (progn
-						 (valid-instance-p z)
-						 t)
-				   (Condition () nil))))
-			    (list :topic z :is-type l-is-type :is-instance l-is-instance)))
+	   (map 'list
+		#'(lambda(z)
+		    (let ((l-is-type
+			   (handler-case
+			       (progn
+				 (topictype-p z topictype topictype-constraint
+					      nil revision)
+				 t)
+			     (Condition () nil)))
+			  (l-is-instance
+			   (handler-case (progn
+					   (valid-instance-p z nil nil revision)
+					   t)
+			     (Condition () nil))))
+		      (list :topic z :is-type l-is-type :is-instance l-is-instance)))
 		(remove-duplicates
-		 (remove-if #'null
-			    (remove-if #'(lambda(x) (when (eql topic-instance x)
-						      t))
-				       (get-direct-subtypes-of-topic topic-instance)))))))
+		 (remove-if
+		  #'null
+		  (remove-if #'(lambda(x) (when (eql topic-instance x)
+					    t))
+			     (get-direct-subtypes-of-topic topic-instance
+							   :revision revision)))))))
       (list :topic topic-instance
 	    :is-type is-type
 	    :is-instance is-instance
 	    :instances (map 'list #'(lambda(x)
-				      (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance)))
+				      (make-nodes (getf x :topic)
+						  (getf x :is-type)
+						  (getf x :is-instance)
+						  :revision revision))
 			    isas-of-this)
 	    :subtypes (map 'list #'(lambda(x)
-				      (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance)))
-			    akos-of-this)))))
+				      (make-nodes (getf x :topic)
+						  (getf x :is-type)
+						  (getf x :is-instance)
+						  :revision revision))
+			   akos-of-this)))))
 
 
-(defun get-all-tree-roots ()
+(defun get-all-tree-roots (&key (revision *TM-REVISION*))
   "Returns all topics that are no instanceOf and no subtype 
    of any other topic."
-  (let ((all-topics
-	 (elephant:get-instances-by-class 'd:TopicC)))
-    (remove-if #'null
-	       (map 'list #'(lambda(x)
-			      (let ((isas-of-x
-				     (remove-if #'(lambda(y)
-						    (when (eql y x)
-						      t))
-						(get-direct-types-of-topic x)))
-				    (akos-of-x
-				     (remove-if #'(lambda(y)
-						    (when (eql y x)
-						      t))
-						(get-direct-supertypes-of-topic x))))
-				(unless (or isas-of-x akos-of-x)
-				  x)))
-		    all-topics))))
\ No newline at end of file
+  (declare (type (or integer null) revision))
+  (let ((all-topics (get-all-topics revision)))
+    (remove-if
+     #'null
+     (map 'list
+	  #'(lambda(x)
+	      (let ((isas-of-x
+		     (remove-if #'(lambda(y)
+				    (when (eql y x)
+				      t))
+				(get-direct-types-of-topic x :revision revision)))
+		    (akos-of-x
+		     (remove-if
+		      #'(lambda(y)
+			  (when (eql y x)
+			    t))
+		      (get-direct-supertypes-of-topic x :revision revision))))
+		(unless (or isas-of-x akos-of-x)
+		  x)))
+	  all-topics))))
\ No newline at end of file

Modified: branches/new-datamodel/src/json/json_tmcl_validation.lisp
==============================================================================
--- branches/new-datamodel/src/json/json_tmcl_validation.lisp	(original)
+++ branches/new-datamodel/src/json/json_tmcl_validation.lisp	Wed Jun 23 14:00:14 2010
@@ -19,261 +19,324 @@
 (in-package :json-tmcl)
 
 
-(defun abstract-p (topic-instance)
+(defun abstract-p (topic-instance &key (revision *TM-REVISION*))
   "Returns t if this topic type is an abstract topic type."
-  (let ((constraint-role (get-item-by-psi *constraint-role-psi*))
-	(topictype-role (get-item-by-psi *topictype-role-psi*))
-	(applies-to (get-item-by-psi *applies-to-psi*))
-	(abstract-topictype-constraint (get-item-by-psi *abstract-topictype-constraint-psi*)))
-    
-    (loop for role in (player-in-roles topic-instance)
-       when (and (eq topictype-role (instance-of role))
-		 (eq applies-to (instance-of (parent role))))
-       return (loop for other-role in (roles (parent role))
-		 when (and (eq constraint-role (instance-of other-role))
-			   (topictype-of-p (player other-role) abstract-topictype-constraint))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance))
+  (let ((constraint-role (get-item-by-psi *constraint-role-psi* :revision revision))
+	(topictype-role (get-item-by-psi *topictype-role-psi* :revision revision))
+	(applies-to (get-item-by-psi *applies-to-psi* :revision revision))
+	(abstract-topictype-constraint
+	 (get-item-by-psi *abstract-topictype-constraint-psi* :revision revision)))
+    (loop for role in (player-in-roles topic-instance :revision revision)
+       when (and (eq topictype-role (instance-of role :revision revision))
+		 (eq applies-to (instance-of (parent role :revision revision)
+					     :revision revision)))
+       return (loop for other-role in (roles (parent role :revision revision)
+					     :revision revision)
+		 when (and (eq constraint-role (instance-of other-role
+							    :revision revision))
+			   (topictype-of-p (player other-role :revision revision)
+					   abstract-topictype-constraint nil nil
+					   nil revision))
 		 return t))))
 
 
-(defun topictype-of-p (topic-instance type-instance &optional (topictype (get-item-by-psi *topictype-psi*))
-		                                              (topictype-constraint (is-type-constrained))
-                                                               checked-topics)
+(defun topictype-of-p (topic-instance type-instance &optional
+		       (topictype (get-item-by-psi *topictype-psi* :revision 0))
+		       (topictype-constraint (is-type-constrained :revision 0))
+		       checked-topics (revision *TM-REVISION*))
   "Returns a list of all types and supertypes of this topic if this topic is a
    valid instance-topic of the type-topic called type-instance. TMCL 4.4.2.
    When the type-instance is set to nil there will be checked only if the
    topic-instance is a valid instance."
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (type (or TopicC null) topictype-constraint)
+	   (list checked-topics))
   (let ((current-checked-topics (append checked-topics (list topic-instance)))
-	(isas-of-this (get-direct-types-of-topic topic-instance))
-	(akos-of-this (get-direct-supertypes-of-topic topic-instance)))
-
+	(isas-of-this (get-direct-types-of-topic topic-instance :revision revision))
+	(akos-of-this (get-direct-supertypes-of-topic topic-instance
+						      :revision revision)))
     (when (eq topic-instance topictype)
       t)
-
     (when (and (not isas-of-this)
 	       (not akos-of-this))
       (return-from topictype-of-p nil))
-
     (loop for isa-of-this in isas-of-this
-       do (let ((found-topics (topictype-p isa-of-this topictype topictype-constraint)))
+       do (let ((found-topics
+		 (topictype-p isa-of-this topictype topictype-constraint nil revision)))
 	    (when (not found-topics)
 	      (return-from topictype-of-p nil))
 	    (dolist (item found-topics)
 	      (pushnew item current-checked-topics))))
-
     (loop for ako-of-this in akos-of-this
        when (not (find ako-of-this current-checked-topics :test #'eq))
-       do (let ((found-topics (topictype-of-p ako-of-this type-instance topictype topictype-constraint current-checked-topics)))
+       do (let ((found-topics
+		 (topictype-of-p ako-of-this type-instance topictype
+				 topictype-constraint current-checked-topics
+				 revision)))
 	    (when (not found-topics)
 	      (return-from topictype-of-p nil))
 	    (dolist (item found-topics)
 	      (pushnew item current-checked-topics))))
-
     (if type-instance
 	(when (find type-instance current-checked-topics)
 	  current-checked-topics)
 	current-checked-topics)))
 
 
-(defun topictype-p (topic-instance &optional (topictype (get-item-by-psi *topictype-psi*))
-		                             (topictype-constraint (is-type-constrained))
-		                             (checked-topics nil))
+(defun topictype-p (topic-instance &optional
+		    (topictype (get-item-by-psi *topictype-psi* :revision 0))
+		    (topictype-constraint (is-type-constrained :revision 0))
+		    (checked-topics nil) (revision *TM-REVISION*))
   "Returns a list of all instanceOf-topics and all Supertypes of this topic
    if this topic is a valid topic (-type). I.e. the passed topic is the
    topictype or it is an instanceOf of the topictype or it is a subtype of
    the topictype. TMDM 7.2 + TMDM 7.3"
-  ;(format t "~%~%topictype-p ~a~%" (uri (first (psis topic-instance))))
+  (declare (type (or integer null) revision)
+	   (TopicC topictype)
+	   (list checked-topics)
+	   (type (or TopicC null) topictype-constraint topictype))
   (let ((current-checked-topics (append checked-topics (list topic-instance)))
-	(akos-of-this (get-direct-supertypes-of-topic topic-instance))
-	(isas-of-this (get-direct-types-of-topic topic-instance)))
-
+	(akos-of-this (get-direct-supertypes-of-topic topic-instance
+						      :revision revision))
+	(isas-of-this (get-direct-types-of-topic topic-instance :revision revision)))
     (when (eq topictype topic-instance)
       (return-from topictype-p current-checked-topics))
-
     (when (not (union akos-of-this isas-of-this :test #'eq))
       (when topictype-constraint
-	;(return-from topictype-p nil))
-	(error "~a is not a valid type for ~a" (uri (first (psis topic-instance))) (uri (first (psis topictype)))))
+	(error "~a is not a valid type for ~a"
+	       (uri (first (psis topic-instance :revision revision)))
+	       (uri (first (psis topictype :revision revision)))))
       (return-from topictype-p current-checked-topics))
-
     (let ((akos-are-topictype nil))
       (loop for ako-of-this in akos-of-this
 	 when (not (find ako-of-this current-checked-topics))
-	 do (let ((further-topics (topictype-p ako-of-this topictype topictype-constraint)))
+	 do (let ((further-topics
+		   (topictype-p ako-of-this topictype topictype-constraint
+				nil revision)))
 	      (if further-topics
 		  (progn
 		    (dolist (item further-topics)
 		      (pushnew item current-checked-topics))
 		    (pushnew ako-of-this akos-are-topictype))
 		  (when topictype-constraint
-		    ;(return-from topictype-p nil)))))
-		    (error "~a is not a valid type for ~a" (uri (first (psis topic-instance))) (uri (first (psis topictype))))))))
-
+		    (error "~a is not a valid type for ~a"
+			   (uri (first (psis topic-instance :revision revision)))
+			   (uri (first (psis topictype :revision revision))))))))
       (when isas-of-this
 	(let ((topictype-topics-of-isas nil))
 	  (loop for isa-of-this in isas-of-this
-	     do (let ((topic-akos (subtype-p isa-of-this topictype)))
+	     do (let ((topic-akos (subtype-p isa-of-this topictype nil revision)))
 		  (when topic-akos
 		    (pushnew isa-of-this topictype-topics-of-isas)
 		    (pushnew isa-of-this current-checked-topics)
 		    (dolist (item topic-akos)
 		      (pushnew item current-checked-topics)))))
-	  
 	  (when (and (not topictype-topics-of-isas)
 		     (not akos-are-topictype)
 		     topictype-constraint)
-	    ;(return-from topictype-p nil))
-	    (error "~a is not a valid type for ~a" (uri (first (psis topic-instance))) (uri (first (psis topictype)))))
-	  
+	    (error "~a is not a valid type for ~a"
+		   (uri (first (psis topic-instance :revision revision)))
+		   (uri (first (psis topictype :revision revision)))))
 	  (loop for isa-of-this in isas-of-this
 	     when (and (not (find isa-of-this current-checked-topics :test #'eq))
 		       (not (find isa-of-this topictype-topics-of-isas :test #'eq)))
-	     do (let ((further-topic-types (topictype-p isa-of-this topictype topictype-constraint current-checked-topics)))
+	     do (let ((further-topic-types
+		       (topictype-p isa-of-this topictype topictype-constraint
+				    current-checked-topics revision)))
 		  (if further-topic-types
 		      (dolist (item further-topic-types)
 			(pushnew item current-checked-topics))
 		      (when topictype-constraint
-			;(return-from topictype-p nil))))))))
-			(error "~a is not a valid type for ~a" (uri (first (psis topic-instance))) (uri (first (psis topictype)))))))))))
+			(error "~a is not a valid type for ~a"
+			       (uri (first (psis topic-instance :revision revision)))
+			       (uri (first (psis topictype :revision revision)))))))))))
     current-checked-topics))
 
 
-(defun subtype-p (topic-instance &optional (topictype (get-item-by-psi *topictype-psi*)) (checked-topics nil))
+(defun subtype-p (topic-instance &optional
+		  (topictype (get-item-by-psi *topictype-psi* :revision 0))
+		  (checked-topics nil) (revision *TM-REVISION*))
   "Returns a list of all supertypes of the passed topic if the passed topic
    is not an instanceOf any other topic but a subtype of some supertypes
    of a topictype or it is the topictype-topic itself.
    This function isn't useable as a standalone function - it's only necessary
    for a special case in the function topictype-p."
-  ;(format t "~%~%subtype-p ~a~%" (uri (first (psis topic-instance))))
-  (let ((current-checked-topics (remove-duplicates (append checked-topics (list topic-instance)))))
-
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (type (or TopicC null) topictype)
+	   (list checked-topics))
+  (let ((current-checked-topics
+	 (remove-duplicates (append checked-topics (list topic-instance)))))
     (when (eq topictype topic-instance)
       (return-from subtype-p current-checked-topics))
-
-    (when (get-direct-types-of-topic topic-instance)
+    (when (get-direct-types-of-topic topic-instance :revision revision)
       (return-from subtype-p nil))
-
-    (let ((supertypes-of-this (get-direct-supertypes-of-topic topic-instance)))
+    (let ((supertypes-of-this
+	   (get-direct-supertypes-of-topic topic-instance :revision revision)))
       (when (not supertypes-of-this)
 	(return-from subtype-p nil))
       (when supertypes-of-this
 	(loop for supertype-of-this in supertypes-of-this
 	   when (not (find supertype-of-this current-checked-topics :test #'eq))
-	   do (let ((further-supertypes (subtype-p topictype supertype-of-this current-checked-topics)))
+	   do (let ((further-supertypes
+		     (subtype-p topictype supertype-of-this current-checked-topics
+				revision)))
 		(when (not further-supertypes)
 		  (return-from subtype-p nil))
-
 		(dolist (item further-supertypes)
 		  (pushnew item current-checked-topics))))))
-
     current-checked-topics))
 
 
-(defun get-direct-types-of-topic(topic-instance)
+(defun get-direct-types-of-topic(topic-instance &key (revision *TM-REVISION*))
   "Returns the direct types of the topic as a list passed to this function.
    This function only returns the types of the type-instance-relationship -> TMDM 7.2
    This function was defined for the use in topictype-p and not for a standalone
    usage."
-  (let ((type-instance (get-item-by-psi *type-instance-psi*))
-	(instance (get-item-by-psi *instance-psi*))
-	(type (get-item-by-psi *type-psi*)))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance))
+  (let ((type-instance (get-item-by-psi *type-instance-psi* :revision revision))
+	(instance (get-item-by-psi *instance-psi* :revision revision))
+	(type (get-item-by-psi *type-psi* :revision revision)))
     (let ((topic-types
-	   (loop for role in (player-in-roles topic-instance)
-	      when (eq instance (instance-of role))
-	      collect (loop for other-role in (roles (parent role))
+	   (loop for role in (player-in-roles topic-instance :revision revision)
+	      when (eq instance (instance-of role :revision revision))
+	      collect (loop for other-role in
+			   (roles (parent role :revision revision) :revision revision)
 			 when (and (not (eq role other-role))
-				   (eq type-instance (instance-of (parent role)))
-				   (eq type (instance-of other-role)))
-			 return (player other-role)))))
+				   (eq type-instance (instance-of
+						      (parent role :revision revision)
+						      :revision revision))
+				   (eq type (instance-of other-role
+							 :revision revision)))
+			 return (player other-role :revision revision)))))
       (when topic-types
 	(remove-if #'null topic-types)))))
 
 
-(defun get-direct-instances-of-topic(topic-instance)
+(defun get-direct-instances-of-topic(topic-instance &key (revision *TM-REVISION*))
   "Returns the direct instances of the topic as a list.
    This function only returns the types of the type-instance-relationship -> TMDM 7.2
    This function was defined for the use in topictype-p and not for a standalone
    usage."
-  (let ((type-instance (get-item-by-psi *type-instance-psi*))
-	(instance (get-item-by-psi *instance-psi*))
-	(type (get-item-by-psi *type-psi*)))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance))
+  (let ((type-instance (get-item-by-psi *type-instance-psi* :revision revision))
+	(instance (get-item-by-psi *instance-psi* :revision revision))
+	(type (get-item-by-psi *type-psi* :revision revision)))
     (let ((topic-instances
-	   (loop for role in (player-in-roles topic-instance)
-	      when (eq type (instance-of role))
-	      collect (loop for other-role in (roles (parent role))
+	   (loop for role in (player-in-roles topic-instance :revision revision)
+	      when (eq type (instance-of role :revision revision))
+	      collect (loop for other-role in (roles (parent role :revision revision)
+						     :revision revision)
 			 when (and (not (eq role other-role))
-				   (eq type-instance (instance-of (parent role)))
-				   (eq instance (instance-of other-role)))
-			 return (player other-role)))))
+				   (eq type-instance
+				       (instance-of (parent role :revision revision)
+						    :revision revision))
+				   (eq instance (instance-of other-role
+							     :revision revision)))
+			 return (player other-role :revision revision)))))
       (when topic-instances
 	(remove-if #'null topic-instances)))))
 
 
-(defun get-direct-supertypes-of-topic(topic-instance)
+(defun get-direct-supertypes-of-topic(topic-instance &key (revision *TM-REVISION*))
   "Returns the direct supertypes of the topic as a list passed to this function.
    This function only returns the types of the supertype-subtype-relationship -> TMDM 7.3.
    This function was defined for the use in topictype-p and not for a standalone
    usage."
-  (let ((supertype-subtype (get-item-by-psi *supertype-subtype-psi*))
-	(supertype (get-item-by-psi *supertype-psi*))
-	(subtype (get-item-by-psi *subtype-psi*)))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance))
+  (let ((supertype-subtype (get-item-by-psi *supertype-subtype-psi* :revision revision))
+	(supertype (get-item-by-psi *supertype-psi* :revision revision))
+	(subtype (get-item-by-psi *subtype-psi* :revision revision)))
     (let ((supertypes
-	   (loop for role in (player-in-roles topic-instance)
-	      when (eq subtype (instance-of role))
-	      append (loop for other-role in (roles (parent role))
+	   (loop for role in (player-in-roles topic-instance :revision revision)
+	      when (eq subtype (instance-of role :revision revision))
+	      append (loop for other-role in (roles (parent role :revision revision)
+						    :revision revision)
 			 when (and (not (eq role other-role))
-				   (eq supertype-subtype (instance-of (parent role)))
-				   (eq supertype (instance-of other-role)))
+				   (eq supertype-subtype
+				       (instance-of (parent role :revision revision)
+						    :revision revision))
+				   (eq supertype
+				       (instance-of other-role :revision revision)))
 			 collect (player other-role)))))
       (when supertypes
 	(remove-if #'null supertypes)))))
 
 
-(defun get-direct-subtypes-of-topic(topic-instance)
+(defun get-direct-subtypes-of-topic(topic-instance &key (revision *TM-REVISION*))
   "Returns the direct subtypes of the topic as a list.
-   This function only returns the types of the supertype-subtype-relationship -> TMDM 7.3.
+   This function only returns the types of the supertype-subtype-relationship
+   -> TMDM 7.3.
    This function was defined for the use in topictype-p and not for a standalone
    usage."
-  (let ((supertype-subtype (get-item-by-psi *supertype-subtype-psi*))
-	(supertype (get-item-by-psi *supertype-psi*))
-	(subtype (get-item-by-psi *subtype-psi*)))
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance))
+  (let ((supertype-subtype (get-item-by-psi *supertype-subtype-psi* :revision revision))
+	(supertype (get-item-by-psi *supertype-psi* :revision revision))
+	(subtype (get-item-by-psi *subtype-psi* :revision revision)))
     (let ((subtypes
-	   (loop for role in (player-in-roles topic-instance)
-	      when (eq supertype (instance-of role))
-	      append (loop for other-role in (roles (parent role))
+	   (loop for role in (player-in-roles topic-instance :revision revision)
+	      when (eq supertype (instance-of role :revision revision))
+	      append (loop for other-role in (roles (parent role :revision revision)
+						    :revision revision)
 			 when (and (not (eq role other-role))
-				   (eq supertype-subtype (instance-of (parent role)))
-				   (eq subtype (instance-of other-role)))
-			 collect (player other-role)))))
+				   (eq supertype-subtype
+				       (instance-of (parent role :revision revision)
+						    :revision revision))
+				   (eq subtype (instance-of other-role
+							    :revision revision)))
+			 collect (player other-role :revision revision)))))
       (when subtypes
 	(remove-if #'null subtypes)))))
 
 
-(defun list-subtypes (topic-instance &optional (topictype (get-item-by-psi *topictype-psi*))
-		                               (topictype-constraint (is-type-constrained))
-		                               (checked-topics nil) (valid-subtypes nil))
+(defun list-subtypes (topic-instance &optional
+		      (topictype (get-item-by-psi *topictype-psi* :revision 0))
+		      (topictype-constraint (is-type-constrained :revision 0))
+		      (checked-topics nil) (valid-subtypes nil)
+		      (revision *TM-REVISION*))
   "Returns all valid subtypes of a topic, e.g.:
    nametype-constraint ako constraint .
    first-name isa nametype .
    first-name-1 ako first-name .
    // ...
-   The return value is a named list of the form (:subtypes (<topic> <...>) :checked-topics (<topic> <...>)"
+   The return value is a named list of the form (:subtypes (<topic> <...>)
+   :checked-topics (<topic> <...>)"
+  (declare (type (or integer null) revision)
+	   (list checked-topics)
+	   (TopicC topic-instance)
+	   (type (or TopicC null) topictype topictype-constraint))
   (let ((current-checked-topics (append checked-topics (list topic-instance))))
-
-    (handler-case (topictype-p topic-instance topictype topictype-constraint)
-      (condition () (return-from list-subtypes (list :subtypes nil :checked-topics current-checked-topics))))
-
-    (let ((subtype (get-item-by-psi *subtype-psi*))
-	  (supertype (get-item-by-psi *supertype-psi*))
-	  (supertype-subtype (get-item-by-psi *supertype-subtype-psi*))
+    (handler-case (topictype-p topic-instance topictype topictype-constraint
+			       nil revision)
+      (condition () (return-from list-subtypes
+		      (list :subtypes nil :checked-topics current-checked-topics))))
+    (let ((subtype (get-item-by-psi *subtype-psi* :revision revision))
+	  (supertype (get-item-by-psi *supertype-psi* :revision revision))
+	  (supertype-subtype (get-item-by-psi *supertype-subtype-psi*
+					      :revision revision))
 	  (current-valid-subtypes (append valid-subtypes (list topic-instance))))
-      (loop for role in (player-in-roles topic-instance)
-	 when (and (eq supertype (instance-of role))
-		   (eq supertype-subtype (instance-of (parent role))))
-	 do (loop for other-role in (roles (parent role))			 
-	       do (when (and (eq subtype (instance-of other-role))
-			     (not (find (player other-role) current-checked-topics)))
+      (loop for role in (player-in-roles topic-instance :revision revision)
+	 when (and (eq supertype (instance-of role :revision revision))
+		   (eq supertype-subtype
+		       (instance-of (parent role :revision revision)
+				    :revision revision)))
+	 do (loop for other-role in (roles (parent role :revision revision)
+					   :revision revision)
+	       do (when (and (eq subtype (instance-of other-role :revision revision))
+			     (not (find (player other-role :revision revision)
+					current-checked-topics)))
 		    (let ((new-values
-			   (list-subtypes (player other-role) topictype topictype-constraint current-checked-topics current-valid-subtypes)))
+			   (list-subtypes (player other-role :revision revision)
+					  topictype topictype-constraint
+					  current-checked-topics
+					  current-valid-subtypes revision)))
 		      (dolist (item (getf new-values :subtypes))
 			(pushnew item current-valid-subtypes))
 		      (dolist (item (getf new-values :checked-topics))
@@ -281,170 +344,211 @@
       (list :subtypes current-valid-subtypes :checked-topics current-checked-topics))))
 
 
-(defun list-instances (topic-instance &optional (topictype (get-item-by-psi *topictype-psi*))
-                                                (topictype-constraint (is-type-constrained)))
-  "Returns the topic-instance, all subtypes found by the function list-subtypes and all direct
-   instances for the found subtypes."
+(defun list-instances (topic-instance &optional
+		       (topictype (get-item-by-psi *topictype-psi* :revision 0))
+		       (topictype-constraint (is-type-constrained :revision 0))
+		       (revision *TM-REVISION*))
+  "Returns the topic-instance, all subtypes found by the function list-subtypes
+   and all direct instances for the found subtypes."
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (type (or TopicC null) topictype topictype-constraint))
   (let ((all-subtypes-of-this
-	 (getf (list-subtypes topic-instance topictype topictype-constraint) :subtypes))
-	(type (get-item-by-psi *type-psi*))
-	(instance (get-item-by-psi *instance-psi*))
-	(type-instance (get-item-by-psi *type-instance-psi*)))
+	 (getf (list-subtypes topic-instance topictype topictype-constraint revision)
+	       :subtypes))
+	(type (get-item-by-psi *type-psi* :revision revision))
+	(instance (get-item-by-psi *instance-psi* :revision revision))
+	(type-instance (get-item-by-psi *type-instance-psi* :revision revision)))
     (let ((all-instances-of-this
 	   (remove-duplicates
 	    (loop for subtype-of-this in all-subtypes-of-this
-	       append (loop for role in (player-in-roles subtype-of-this)
-			 when (and (eq type (instance-of role))
-				   (eq type-instance (instance-of (parent role))))
-			 append (loop for other-role in (roles (parent role))
-				   when (eq instance (instance-of other-role))
-				   collect (player other-role)))))))
+	       append (loop for role in (player-in-roles subtype-of-this
+							 :revision revision)
+			 when (and (eq type (instance-of role :revision revision))
+				   (eq type-instance
+				       (instance-of (parent role :revision revision)
+						    :revision revision)))
+			 append (loop for other-role in
+				     (roles (parent role :revision revision)
+					    :revision revision)
+				   when (eq instance (instance-of other-role
+								  :revision revision))
+				   collect (player other-role :revision revision)))))))
       (let ((all-subtypes-of-all-instances
 	     (remove-if #'null
 			(remove-duplicates
 			 (loop for subtype in all-instances-of-this
-			    append (getf (list-subtypes subtype nil nil) :subtypes))))))
+			    append (getf
+				    (list-subtypes subtype topictype
+						   nil nil nil revision)
+				    :subtypes))))))
 	(union all-instances-of-this 
 	       (remove-if #'null
 			  (map 'list #'(lambda(x)
 					 (handler-case (progn
-							 (topictype-of-p x nil)
+							 (topictype-of-p x nil nil nil
+									 nil revision)
 							 x)
 					   (condition () nil)))
 			       all-subtypes-of-all-instances)))))))
 
 
-(defun valid-instance-p (topic-instance &optional (akos-checked nil) (all-checked-topics nil))
+(defun valid-instance-p (topic-instance &optional
+			 (akos-checked nil) (all-checked-topics nil)
+			 (revision *TM-REVISION*))
   "Returns a list of all checked topics or throws an exception if the given
    topic is not a valid instance of any topictype in elephant."
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (list akos-checked all-checked-topics))
   (let ((isas-of-this
-	 (get-direct-types-of-topic topic-instance))
+	 (get-direct-types-of-topic topic-instance :revision revision))
 	(akos-of-this
-	 (get-direct-supertypes-of-topic topic-instance))
-	(psi-of-this (uri (first (psis topic-instance))))
-	(topictype (d:get-item-by-psi json-tmcl-constants::*topictype-psi*))
-	(topictype-constraint (is-type-constrained))
+	 (get-direct-supertypes-of-topic topic-instance :revision revision))
+	(psi-of-this (uri (first (psis topic-instance :revision revision))))
+	(topictype (get-item-by-psi *topictype-psi* :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision))
 	(local-all-checked-topics all-checked-topics)
 	(local-akos-checked))
-
     (when (not topictype-constraint)
       (return-from valid-instance-p (list topic-instance)))
-
     (when (and topictype-constraint
 	       (not topictype))
-      (error (format nil "From valid-instance-p(): The topic \"~a\" does not exist - please create it or remove the topic \"~a\""
-		     json-tmcl-constants::*topictype-psi* (d:uri (first (d:psis topictype-constraint))))))
-
+      (error "From valid-instance-p(): The topic \"~a\" does not exist - please create it or remove the topic \"~a\""
+	     *topictype-psi*
+	     (uri (first (psis topictype-constraint :revision revision)))))
     (when (eql topic-instance topictype)
-      (return-from valid-instance-p (remove-duplicates (append all-checked-topics (list topic-instance)))))
-
+      (return-from valid-instance-p
+	(remove-duplicates (append all-checked-topics (list topic-instance)))))
     (unless (or isas-of-this akos-of-this)
-      (error (format nil "The topic \"~a\" is not a valid topic-instance for any topic-type" psi-of-this)))
-
+      (error "The topic \"~a\" is not a valid topic-instance for any topic-type"
+	      psi-of-this))
     (when (find topic-instance akos-checked)
       (return-from valid-instance-p all-checked-topics))
-
     (pushnew topic-instance local-all-checked-topics)
     (pushnew topic-instance local-akos-checked)
-
     (dolist (isa isas-of-this)
       (handler-case (let ((topics
-			   (topictype-p isa topictype topictype-constraint)))
+			   (topictype-p isa topictype topictype-constraint
+					nil revision)))
 		      (dolist (top topics)
 			(pushnew top local-all-checked-topics)))
-	(condition (err) (error (format nil "The topic \"~a\" is not a valid topic-instance for any topic-type~%~%~a" psi-of-this err)))))
+	(condition (err) (error "The topic \"~a\" is not a valid topic-instance for any topic-type~%~%~a"
+				psi-of-this err))))
 
     (dolist (ako akos-of-this)
-      (when (not (handler-case (let ((topics
-				      (topictype-p ako topictype topictype-constraint all-checked-topics)))
+      (when (not (handler-case
+		     (let ((topics
+			    (topictype-p ako topictype topictype-constraint
+					 all-checked-topics revision)))
 				 (dolist (top topics)
 				   (pushnew top local-all-checked-topics))
 				 (pushnew ako local-akos-checked)
 				 topics)
 		   (condition () nil)))
-	(handler-case (let ((topics
-			     (valid-instance-p ako akos-checked (append all-checked-topics (list ako)))))
+	(handler-case 
+	    (let ((topics
+		   (valid-instance-p ako akos-checked (append all-checked-topics
+							      (list ako)) revision)))
 			(dolist (top topics)
 			  (pushnew top local-all-checked-topics)
 			  (pushnew top local-akos-checked))
 			topics)
-	  (condition (err) (error (format nil "The topic \"~a\" is not a valid topic-instance for any topic-type~%~%~a" psi-of-this err))))))
+	  (condition (err) (error "The topic \"~a\" is not a valid topic-instance for any topic-type~%~%~a"
+				  psi-of-this err)))))
     local-all-checked-topics))
 
 
-(defun return-all-tmcl-types ()
+(defun return-all-tmcl-types (&key (revision *TM-REVISION*))
   "Returns all topics that are valid tmcl-types"
-  (let ((all-topics
-	 (elephant:get-instances-by-class 'd:TopicC))
-	(topictype (get-item-by-psi json-tmcl-constants::*topictype-psi*))
-	(topictype-constraint (is-type-constrained)))
+  (declare (type (or integer null) revision))
+  (let ((all-topics (get-all-topics revision))
+	(topictype (get-item-by-psi json-tmcl-constants::*topictype-psi*
+				    :revision revision))
+	(topictype-constraint (is-type-constrained :revision revision)))
     (let ((all-types
-	   (remove-if #'null
-		      (map 'list #'(lambda(x)
-				     (handler-case (progn
-						     (topictype-p x topictype topictype-constraint)
-						     x)
-				       (condition () nil))) all-topics))))
+	   (remove-if
+	    #'null
+	    (map 'list #'(lambda(x)
+			   (handler-case
+			       (progn
+				 (topictype-p x topictype topictype-constraint
+					      nil revision)
+				 x)
+			     (condition () nil))) all-topics))))
       (let ((not-abstract-types
 	     (remove-if #'null
 			(map 'list #'(lambda(x)
-				       (unless (json-tmcl:abstract-p x)
+				       (unless (abstract-p x :revision revision)
 					 x))
 			     all-types))))
 	not-abstract-types))))
 
 
-(defun return-all-tmcl-instances ()
+(defun return-all-tmcl-instances (&key (revision *TM-REVISION*))
   "Returns all topics that are valid instances of any topic type.
    The validity is only oriented on the typing of topics, e.g.
    type-instance or supertype-subtype."
-  (let ((all-topics
-	 (elephant:get-instances-by-class 'd:TopicC)))
+  (declare (type (or integer null) revision))
+  (let ((all-topics (get-all-topics revision)))
     (let ((valid-instances
-	   (remove-if #'null
-		      (map 'list #'(lambda(x)
-				     (handler-case (progn
-						     (valid-instance-p x)
-						     x)
-				       (condition () nil))) all-topics))))
+	   (remove-if
+	    #'null
+	    (map 'list #'(lambda(x)
+			   (handler-case (progn
+					   (valid-instance-p x nil nil revision)
+					   x)
+			     (condition () nil))) all-topics))))
       valid-instances)))
 
 
-(defun is-type-constrained (&key (what json-tmcl::*topictype-constraint-psi*))
-  "Returns nil if there is no type-constraint otherwise the instance of the type-constraint."
-  (let ((topictype-constraint (d:get-item-by-psi what)))
+(defun is-type-constrained (&key (what *topictype-constraint-psi*)
+			    (revision *TM-REVISION*))
+  "Returns nil if there is no type-constraint otherwise the instance of
+   the type-constraint."
+  (declare (string what)
+	   (type (or integer null) revision))
+  (let ((topictype-constraint (get-item-by-psi what :revision revision)))
     (when topictype-constraint
       (let ((ttc
 	     (remove-duplicates
-	      (remove-if #'null
-			 (remove-if #'(lambda(x) (when (eql topictype-constraint x)
-						   t))
-				    (get-direct-instances-of-topic topictype-constraint))))))
+	      (remove-if
+	       #'null
+	       (remove-if #'(lambda(x) (when (eql topictype-constraint x)
+					 t))
+			  (get-direct-instances-of-topic topictype-constraint
+							 :revision revision))))))
 	ttc))))
 
 
-(defun list-all-supertypes (topic-instance &optional (checked-topics nil))
+(defun list-all-supertypes (topic-instance &optional (checked-topics nil)
+			    (revision *TM-REVISION*))
   "Returns all supertypes of the given topic recursively."
+  (declare (type (or integer null) revision)
+	   (TopicC topic-instance)
+	   (list checked-topics))
   (let ((current-checked-topics (append checked-topics (list topic-instance)))
-	(akos-of-this (get-direct-supertypes-of-topic topic-instance)))
+	(akos-of-this (get-direct-supertypes-of-topic topic-instance
+						      :revision revision)))
     (dolist (ako-of-this akos-of-this)
       (when (not (find ako-of-this current-checked-topics))
 	(let ((new-checked-topics
-	       (list-all-supertypes ako-of-this current-checked-topics)))
+	       (list-all-supertypes ako-of-this current-checked-topics revision)))
 	  (dolist (new-topic new-checked-topics)
 	    (pushnew new-topic current-checked-topics)))))
     current-checked-topics))
 
 
-(defun get-all-upper-constrainted-topics (topic)
+(defun get-all-upper-constrainted-topics (topic &key (revision *TM-REVISION*))
   "Returns all topics that are supertypes or direct types
    of the given topic-type. So all direct constraints of the found
    topics are valid constraints for the given one."
+  (declare (TopicC topic)
+	   (type (or integer null) revision))
   ;; find all direct types
   (let ((direct-isas-of-this
-	 (get-direct-types-of-topic topic)))
-    
+	 (get-direct-types-of-topic topic :revision revision)))
   ;; find all supertypes (recursive -> transitive relationship
     (let ((all-akos-of-this
-	   (list-all-supertypes topic)))
+	   (list-all-supertypes topic nil revision)))
       (remove-duplicates (union direct-isas-of-this all-akos-of-this)))))
\ No newline at end of file

Modified: branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp	(original)
+++ branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp	Wed Jun 23 14:00:14 2010
@@ -122,7 +122,7 @@
   (declare (ignorable param))
   (handler-case (let ((topic-types 
 		         (with-reader-lock
-			   (json-tmcl::return-all-tmcl-types))))
+			   (json-tmcl::return-all-tmcl-types :revision 0))))
 		  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
 		  (json:encode-json-to-string
 		   (map 'list #'(lambda(y)
@@ -140,7 +140,7 @@
   (declare (ignorable param))
   (handler-case (let ((topic-instances 
 		         (with-reader-lock
-			   (json-tmcl::return-all-tmcl-instances))))
+			   (json-tmcl::return-all-tmcl-instances :revision 0))))
 		  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
 		  (json:encode-json-to-string
 		   (map 'list #'(lambda(y)
@@ -159,8 +159,9 @@
   (let ((topic (d:get-item-by-psi psi)))
     (if topic
 	(let ((topic-json
-	       (handler-case (with-reader-lock
-			       (json-exporter::to-json-topicStub-string topic))
+	       (handler-case
+		   (with-reader-lock
+		     (json-exporter::to-json-topicStub-string topic :revision 0))
 		 (condition (err) (progn
 				    (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
 				    (setf (hunchentoot:content-type*) "text")
@@ -181,23 +182,29 @@
 	    (eq http-method :PUT))
 	(let ((external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF)))
 	  (let ((json-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
-	    (handler-case (let ((psis
-				 (json:decode-json-from-string json-data)))			    
-			    (let ((tmcl
-				   (with-reader-lock
-				     (json-tmcl:get-constraints-of-fragment psis :treat-as treat-as))))
-			      (if tmcl
-				  (progn
-				    (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
-				    tmcl)
-				  (progn
-				    (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
-				    (setf (hunchentoot:content-type*) "text")
-				    (format nil "Topic \"~a\" not found." psis)))))
-	      (condition (err) (progn
-				 (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
-				 (setf (hunchentoot:content-type*) "text")
-				 (format nil "Condition: \"~a\"" err))))))
+	    (handler-case
+		(let ((psis
+		       (json:decode-json-from-string json-data)))
+		  (let ((tmcl
+			 (with-reader-lock
+			   (json-tmcl:get-constraints-of-fragment
+			    psis :treat-as treat-as :revision 0))))
+		    (if tmcl
+			(progn
+			  (setf (hunchentoot:content-type*)
+				"application/json") ;RFC 4627
+			  tmcl)
+			(progn
+			  (setf (hunchentoot:return-code*)
+				hunchentoot:+http-not-found+)
+			  (setf (hunchentoot:content-type*) "text")
+			  (format nil "Topic \"~a\" not found." psis)))))
+	      (condition (err)
+		(progn
+		  (setf (hunchentoot:return-code*)
+			hunchentoot:+http-internal-server-error+)
+		  (setf (hunchentoot:content-type*) "text")
+		  (format nil "Condition: \"~a\"" err))))))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
 
 
@@ -210,7 +217,7 @@
 	(progn
 	  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
 	  (handler-case (with-reader-lock
-			  (get-all-topic-psis))
+			  (get-all-topic-psis :revision 0))
 	    (condition (err) (progn
 			       (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
 			       (setf (hunchentoot:content-type*) "text")
@@ -230,7 +237,7 @@
 		   (get-latest-fragment-of-topic identifier))))
 	    (if fragment
 		(handler-case (with-reader-lock
-				(to-json-string fragment))
+				(to-json-string fragment :revision 0))
 		  (condition (err)
 		    (progn
 		      (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
@@ -332,14 +339,17 @@
   "Returns a json-object representing a topic map overview as a tree(s)"
   (declare (ignorable param))
   (with-reader-lock
-      (handler-case (let ((json-string
-			   (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view))))
-		      (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
-		      json-string)
-	(Condition (err) (progn
-			   (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
-			   (setf (hunchentoot:content-type*) "text")
-			   (format nil "Condition: \"~a\"" err))))))
+      (handler-case
+	  (let ((json-string
+		 (json-tmcl::tree-view-to-json-string
+		  (json-tmcl::make-tree-view :revision 0))))
+	    (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+	    json-string)
+	(Condition (err)
+	  (progn
+	    (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+	    (setf (hunchentoot:content-type*) "text")
+	    (format nil "Condition: \"~a\"" err))))))
 
 
 ;; =============================================================================

Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp
==============================================================================
--- branches/new-datamodel/src/unit_tests/datamodel_test.lisp	(original)
+++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp	Wed Jun 23 14:00:14 2010
@@ -482,7 +482,7 @@
 	(is (eql top-3
 		 (get-item-by-id
 		  (concatenate 'string "t" (write-to-string
-					    (elephant::oid top-3))) 
+					    (elephant::oid top-3)))
 		  :revision rev-0)))
 	(is-false (get-item-by-id
 		   (concatenate 'string "t" (write-to-string

    

[isidorus-cvs] r304 - in branches/new-datamodel/src: json rest_interface unit_tests

Lukas Giessmann