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

[Lukas Giessmann]

Author: lgiessmann
Date: Sun Mar 21 04:36:20 2010
New Revision: 236

Log:
new-datamodel: optimized "make-construct"

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

Modified: branches/new-datamodel/src/model/changes.lisp
==============================================================================
--- branches/new-datamodel/src/model/changes.lisp	(original)
+++ branches/new-datamodel/src/model/changes.lisp	Sun Mar 21 04:36:20 2010
@@ -1,4 +1,4 @@
-#;;+-----------------------------------------------------------------------------
+;;+-----------------------------------------------------------------------------
 ;;+  Isidorus
 ;;+  (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann
 ;;+

Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Sun Mar 21 04:36:20 2010
@@ -1645,7 +1645,7 @@
     (eql class-symbol 'NameC)))
 
 
-(defgeneric initialize-name (construct variants &key start-revision)
+(defgeneric complete-name (construct variants &key start-revision)
   (:documentation "Adds all given variants to the passed construct.")
   (:method ((construct NameC) (variants list)
 	    &key (start-revision *TM-REVISION*))
@@ -1966,7 +1966,7 @@
 	(CharacteristicC-p class-symbol))))
 
 
-(defgeneric initialize-reifiable (construct item-identifiers reifier
+(defgeneric complete-reifiable (construct item-identifiers reifier
 					    &key start-revision)
   (:documentation "Adds all item-identifiers and the reifier to the passed
                    construct.")
@@ -2146,7 +2146,7 @@
 	(CharacteristicC-p class-symbol))))
 
 
-(defgeneric initialize-typable (construct instance-of &key start-revision)
+(defgeneric complete-typable (construct instance-of &key start-revision)
   (:documentation "Adds the passed instance-of to the given construct.")
   (:method ((construct TypableC) instance-of
 	    &key (start-revision *TM-REVISION*))
@@ -2176,7 +2176,7 @@
 	(CharacteristicC-p class-symbol))))
 
 
-(defgeneric initialize-scopable (construct themes &key start-revision)
+(defgeneric complete-scopable (construct themes &key start-revision)
   (:documentation "Adds all passed themes to the given construct.")
   (:method ((construct ScopableC) (themes list)
 	    &key (start-revision *TM-REVISION*))
@@ -2394,17 +2394,25 @@
 	   ((RoleC-p class-symbol)
 	    (make-role args))
 	   ((AssociationC-p class-symbol)
-	    (make-association args)))))
-    construct))
+	    (make-association args))))
+	(start-revision (getf args :start-revision)))
+    (when (typep construct 'TypableC)
+      (complete-typable construct (getf args :instance-of)
+			:start-revision start-revision))
+    (when (typep construct 'ScopableC)
+      (complete-scopable construct (getf args :themes)
+			 :start-revision start-revision))
+    (if (typep construct 'ReifiableConstructC)
+	(complete-reifiable construct (getf args :item-identtifiers)
+			    (getf args :reifier) :start-revision start-revision)
+	construct)))
 
 
 (defun make-association (args)
   "Returns an association object. If the association has already existed the
    existing one is returned otherwise a new one is created.
    This function exists only for being used by make-construct!"
-  (let ((item-identifiers (getf (first args) :item-identifiers))
-	(reifier (getf (first args) :reifier))
-	(instance-of (getf (first args) :instance-of))
+  (let ((instance-of (getf (first args) :instance-of))
 	(start-revision (getf (first args) :start-revision))
 	(themes (get (first args) :themes))
 	(roles (get (first args) :roles))
@@ -2427,23 +2435,16 @@
 	     (if existing-association
 		 existing-association
 		 (make-instance 'AssociationC)))))
-      (initialize-typable association instance-of :start-revision
-			  start-revision)
       (dolist (role roles)
 	(add-role association role :revision start-revision))
-      (dolist (theme themes)
-	(add-theme association theme :revision start-revision))
-      (initialize-reifiable association item-identifiers reifier
-			    :start-revision start-revision))))
+      association)))
 
 
 (defun make-role (args)
   "Returns a role object. If the role has already existed the
    existing one is returned otherwise a new one is created.
    This function exists only for being used by make-construct!"
-  (let ((item-identifiers (getf args :item-identifiers))
-	(reifier (getf args :reifier))
-	(parent (getf args :parent))
+  (let ((parent (getf args :parent))
 	(instance-of (getf args :instance-of))
 	(player (getf args :player))
 	(start-revision (getf args :start-revision))
@@ -2467,11 +2468,9 @@
 		 (make-instance 'RoleC)))))
       (when player
 	(add-player role player :revision start-revision))
-      (initialize-typable role instance-of :start-revision start-revision)
       (when parent
 	(add-parent role parent :revision start-revision))
-      (initialize-reifiable role item-identifiers reifier
-			    :start-revision start-revision))))
+      role)))
 
 
 (defun make-tm (args)
@@ -2505,8 +2504,7 @@
 		    (make-instance 'TopicMapC))))))
       (dolist (top-or-assoc (union topics assocs))
 	(add-to-tm tm top-or-assoc))
-      (initialize-reifiable tm item-identifiers reifier
-			    :start-revision start-revision))))
+      tm)))
 	   
 
 (defun make-topic (&rest args)
@@ -2543,9 +2541,6 @@
 		   (t
 		    (make-instance 'TopicC))))))
       (let ((merged-topic topic))
-	(setf merged-topic
-	      (initialize-reifiable topic item-identifiers nil
-				    :start-revision start-revision))
 	(dolist (psi psis)
 	  (setf merged-topic (add-psi merged-topic psi
 				      :revision start-revision)))
@@ -2572,9 +2567,7 @@
 	(instance-of (getf (first args) :instance-of))
 	(themes (getf (first args) :themes))
 	(variants (getf (first args) :variants))
-	(reifier (getf (first args) :reifier))
 	(parent (getf (first args) :parent))
-	(item-identifiers (getf (first args) :item-identifiers))
 	(err "From make-characteristic(): "))
     (unless start-revision (error "~astart-revision must be set" err))
     (unless charvalue (error "~acharvalue must be set" err))
@@ -2599,14 +2592,10 @@
 		 existing-characteristic
 		 (make-instance class-symbol :charvalue charvalue
 				:datatype datatype)))))
-      (initialize-scopable characteristic themes :start-revision start-revision)
-      (initialize-typable characteristic instance-of
-			  :start-revision start-revision)
-      (initialize-name characteristic variants :start-revision start-revision)
+      (complete-name characteristic variants :start-revision start-revision)
       (when parent
 	(add-parent characteristic parent :revision start-revision))
-      (initialize-reifiable characteristic item-identifiers
-			    reifier :start-revision start-revision))))
+      characteristic)))
 
 
 (defun make-pointer (class-symbol &rest args)