Changeset 236 for branches/new-datamodel

Timestamp:

03/21/10 08:36:20 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: optimized "make-construct"

Location:

branches/new-datamodel/src/model

Files:

• changes.lisp (modified) (1 diff)
• datamodel.lisp (modified) (13 diffs)

branches/new-datamodel/src/model/changes.lisp ¶

@@ -1 @@
-#;;+-----------------------------------------------------------------------------
+;;+-----------------------------------------------------------------------------
 ;;+  Isidorus
 ;;+  (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -1646 +1646 @@
 
 
-(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)
@@ -1967 +1967 @@
 
 
-(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
@@ -2147 +2147 @@
 
 
-(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
@@ -2177 +2177 @@
 
 
-(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)
@@ -2395 +2395 @@
             (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)))
 
 
@@ -2403 +2413 @@
    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))
@@ -2428 +2436 @@
                  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)))
 
 
@@ -2442 +2445 @@
    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))
@@ -2468 +2469 @@
       (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)))
 
 
@@ -2506 +2505 @@
       (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)))
            
 
@@ -2544 +2542 @@
                     (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
@@ -2573 +2568 @@
         (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))
@@ -2600 +2593 @@
                  (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)))