Changeset 243 for branches/new-datamodel

Timestamp:

03/22/10 11:54:27 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: added "make-construct" for VersionedAssocitionC and unknown classes via "(apply make-instance class-symbol args)" replaced all "make-instance" and "add-to-version-history" calls by "make-construct" in all add-<whatever> generics

Location:

branches/new-datamodel/src

Files:

• model/datamodel.lisp (modified) (18 diffs)
• unit_tests/datamodel_test.lisp (modified) (4 diffs)

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

@@ -147 +147 @@
            :check-for-duplicate-identifiers
            :find-item-by-content
+           :rec-remf
 
            ;;globals
@@ -162 +163 @@
 ;;      (--> duplicate-identifier-error)
 ;;TODO: finalize add-reifier
-;;TODO: replace add-to-version-history in VersionedAssociationC with a pseudo
-;;      initarg in make-construct
 ;;TODO: implement a macro "with-merge-construct" that merges constructs
 ;;      after some data-operations are completed (should be passed as body)
@@ -624 +623 @@
 
 ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun rec-remf (plist keyword)
+  "Calls remf for the past plist with the given keyword until
+    all key-value-pairs corresponding to the passed keyword were removed."
+  (declare (list plist) (keyword keyword))
+  (loop while (getf plist keyword)
+     do (remf plist keyword))
+  plist)
+
+
 (defun get-item-by-content (content &key (revision *TM-REVISION*))
   "Finds characteristics by their (atomic) content."
@@ -1221 +1229 @@
                  (add-to-version-history ti-assoc :start-revision revision)))
               (t
-               (let ((assoc (make-instance 'TopicIdAssociationC
-                                           :parent-construct construct
-                                           :identifier topic-identifier)))
-                 (add-to-version-history assoc :start-revision revision))))
+               (make-construct 'TopicIdAssociationC
+                               :parent-construct construct
+                               :identifier topic-identifier
+                               :start-revision revision)))
         (add-to-version-history merged-construct :start-revision revision)
         merged-construct))))
@@ -1276 +1284 @@
                  (add-to-version-history psi-assoc :start-revision revision)))
               (t
-               (let ((assoc (make-instance 'PersistentIdAssociationC
-                                           :parent-construct construct
-                                           :identifier psi)))
-                 (add-to-version-history assoc :start-revision revision))))
+               (make-construct 'PersistentIdAssociationC
+                               :parent-construct construct
+                               :identifier psi
+                               :start-revision revision)))
         (add-to-version-history merged-construct :start-revision revision)
         merged-construct))))
@@ -1332 +1340 @@
                  (add-to-version-history loc-assoc :start-revision revision)))
               (t
-               (let ((assoc
-                      (make-instance 'SubjectLocatorAssociationC
-                                     :parent-construct construct
-                                     :identifier locator)))
-                 (add-to-version-history assoc :start-revision revision))))
+               (make-construct 'SubjectLocatorAssociationC
+                               :parent-construct construct
+                               :identifier locator
+                               :start-revision revision)))
         (add-to-version-history merged-construct :start-revision revision)
         merged-construct))))
@@ -1391 +1398 @@
                                return name-assoc)))
             (add-to-version-history name-assoc :start-revision revision))
-          (let ((assoc
-                 (make-instance 'NameAssociationC
-                                :parent-construct construct
-                                :characteristic name)))
-            (add-to-version-history assoc :start-revision revision))))
+          (make-construct 'NameAssociationC
+                          :parent-construct construct
+                          :characteristic name
+                          :start-revision revision)))
     (add-to-version-history construct :start-revision revision)
     construct))
@@ -1441 +1447 @@
                               return occ-assoc)))
             (add-to-version-history occ-assoc :start-revision revision))
-          (let ((assoc
-                 (make-instance 'OccurrenceAssociationC
-                                :parent-construct construct
-                                :characteristic occurrence)))
-            (add-to-version-history assoc :start-revision revision))))
+          (make-construct 'OccurrenceAssociationC
+                          :parent-construct construct
+                          :characteristic occurrence
+                          :start-revision revision)))
     (add-to-version-history construct :start-revision revision)
     construct))
@@ -1733 +1738 @@
                                            (t
                                             'VariantAssociationC))))
-               (let ((assoc (make-instance association-type
-                                           :characteristic construct
-                                           :parent-construct parent-construct)))
-                 (add-to-version-history assoc :start-revision revision))))))
+               (make-construct association-type
+                               :characteristic construct
+                               :parent-construct parent-construct
+                               :start-revision revision)))))
     construct))
 
@@ -1865 +1870 @@
                     return variant-assoc)))
             (add-to-version-history variant-assoc :start-revision revision))
-          (let ((assoc
-                 (make-instance 'VariantAssociationC
-                                :characteristic variant
-                                :parent-construct construct)))
-            (add-to-version-history assoc :start-revision revision))))
+          (make-construct 'VariantAssociationC
+                          :characteristic variant
+                          :parent-construct construct
+                          :start-revision revision)))
     construct))
 
@@ -1950 +1954 @@
                     return role-assoc)))
             (add-to-version-history role-assoc  :start-revision revision))
-          (let ((assoc
-                 (make-instance 'RoleAssociationC
-                                :role role
-                                :parent-construct construct)))
-            (add-to-version-history assoc :start-revision revision))))
+          (make-construct 'RoleAssociationC
+                          :role role
+                          :parent-construct construct
+                          :start-revision revision)))
     (add-to-version-history construct :start-revision revision)
     construct))
@@ -2044 +2047 @@
            (add-to-version-history same-parent-assoc :start-revision revision))
           (t
-           (let ((assoc (make-instance 'RoleAssociationC
-                                       :role construct
-                                       :parent-construct parent-construct)))
-             (add-to-version-history assoc :start-revision revision)))))
+           (make-construct 'RoleAssociationC
+                           :role construct
+                           :parent-construct parent-construct
+                           :start-revision revision))))
   (add-to-version-history parent-construct :start-revision revision)
   construct)
@@ -2096 +2099 @@
              (add-to-version-history same-player-assoc :start-revision revision))
             (t
-             (let ((assoc (make-instance 'PlayerAssociationC
-                                         :parent-construct construct
-                                         :player-topic player-topic)))
-               (add-to-version-history assoc :start-revision revision)))))
+             (make-construct 'PlayerAssociationC
+                             :parent-construct construct
+                             :player-topic player-topic
+                             :start-revision revision))))
     construct))
 
@@ -2238 +2241 @@
                  (add-to-version-history ii-assoc :start-revision revision)))
               (t
-               (let ((assoc (make-instance 'ItemIdAssociationC
-                                           :parent-construct construct
-                                           :identifier item-identifier)))
-                 (add-to-version-history assoc :start-revision revision))))
+               (make-construct 'ItemIdAssociationC
+                               :parent-construct construct
+                               :identifier item-identifier
+                               :start-revision revision)))
         (when (or (typep merged-construct 'TopicC)
                   (typep merged-construct 'AssociationC)
@@ -2292 +2295 @@
                  (merge-constructs (first all-constructs) construct))
                 (t
-                 (let ((assoc (make-instance 'ReifierAssociationC
-                                             :reifiable-construct construct
-                                             :reifier-topic merged-reifier-topic)))
-                   (add-to-version-history assoc :start-revision revision))))
+                 (make-construct 'ReifierAssociationC
+                                 :reifiable-construct construct
+                                 :reifier-topic merged-reifier-topic
+                                 :start-revision revision)))
           (when (or (typep merged-construct 'TopicC)
                     (typep merged-construct 'AssociationC)
@@ -2410 +2413 @@
                     return theme-assoc)))
             (add-to-version-history theme-assoc  :start-revision revision))
-          (let ((assoc
-                 (make-instance 'ScopeAssociationC
-                                :theme-topic theme-topic
-                                :scopable-construct construct)))
-            (add-to-version-history assoc :start-revision revision))))
+          (make-construct 'ScopeAssociationC
+                          :theme-topic theme-topic
+                          :scopable-construct construct
+                          :start-revision revision)))
     (when (typep construct 'AssociationC)
       (add-to-version-history construct :start-revision revision))
@@ -2482 +2484 @@
              (add-to-version-history same-type-assoc :start-revision revision))
             (t
-             (let ((assoc
-                    (make-instance 'TypeAssociationC
-                                   :type-topic type-topic
-                                   :typable-construct construct)))
-               (add-to-version-history assoc :start-revision revision)))))
+             (make-construct 'TypeAssociationC
+                             :type-topic type-topic
+                             :typable-construct construct
+                             :start-revision revision))))
     (when (typep construct 'AssociationC)
       (add-to-version-history construct :start-revision revision))
@@ -2583 +2584 @@
            ((AssociationC-p class-symbol)
             (apply #'make-association args))
+           ((VersionedConstructC-p class-symbol)
+            (apply #'make-instance (rec-remf args :start-revision)))
            (t
             (apply #'make-instance class-symbol args))))

branches/new-datamodel/src/unit_tests/datamodel_test.lisp ¶

@@ -909 +909 @@
       (is (= (length (union (list tm-1)
                             (in-topicmaps top-1))) 1))
-      (is-false (topics tm-1 :revision revision-0-5))
       (is-false (in-topicmaps top-1 :revision revision-0-5))
       (d::add-to-version-history assoc-1 :start-revision revision-1)
@@ -917 +916 @@
       (is (= (length (union (list tm-1)
                             (in-topicmaps assoc-1))) 1))
-      (is-false (associations tm-1 :revision revision-0-5))
       (is-false (in-topicmaps assoc-1 :revision revision-0-5))
       (add-to-tm tm-2 top-1)
@@ -924 +922 @@
       (is (= (length (union (list tm-2 tm-1)
                             (in-topicmaps top-1))) 2))
-      (is-false (topics tm-2 :revision revision-0-5))
       (is-false (in-topicmaps top-1 :revision revision-0-5))
       (d::add-to-version-history assoc-1 :start-revision revision-1)
@@ -932 +929 @@
       (is (= (length (union (list tm-2 tm-1)
                             (in-topicmaps assoc-1))) 2))
-      (is-false (associations tm-2 :revision revision-0-5))
       (is-false (in-topicmaps assoc-1 :revision revision-0-5)))))