Changeset 2354 for branches

Timestamp:

2015-06-18T20:59:23-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/monom.lisp (modified) (1 diff)

branches/f4grobner/monom.lisp

@@ -86 +86 @@
                                        )
   ;;(format t "MONOM::SHARED-INITIALIZE called with:~&SLOT-NAMES: ~W~&INITARGS: ~W.~%" slot-names initargs)
-  (let* ((new-dimension (cond (dimension dimension)
-                              (exponents
-                               (length exponents))
-                              (t 
-                               (error "DIMENSION or EXPONENTS must not be NIL"))))
-         (new-exponents  (cond 
-                           ;; when exponents are supplied
-                           (exponents
-                            (make-array (list new-dimension) :initial-contents exponents))
-                           ;; when all exponents are to be identical
-                           (exponent
-                            (make-array (list new-dimension) :initial-element exponent
-                                        :element-type 'exponent))
-                           ;; otherwise, all exponents are zero
-                           (t 
-                            (make-array (list new-dimension) :element-type 'exponent :initial-element 0)))))
-    (setf (slot-value self 'dimension) new-dimension
-          (slot-value self 'exponents) new-exponents)))
+  (if (eq slot-names t) (setf slot-names '(dimension exponents)))
+  (dolist (slot-name slot-names)
+    (ecase slot-name
+      (dimension 
+       (cond (dimension (setf (slot-value self 'dimension)) dimension)
+             (exponents
+              (setf (slot-value self 'dimension) (length exponents)))
+             (t 
+              (error "DIMENSION or EXPONENTS must not be NIL"))))
+      (exponents  
+       (cond 
+         ;; when exponents are supplied
+         (exponents
+          (setf (slot-value self 'exponents) 
+                (make-array (slot-value self 'dimension) :initial-contents exponents)))
+         ;; when all exponents are to be identical
+         (exponent
+          (setf (slot-value self 'exponents)
+                (make-array (list new-dimension) :initial-element exponent
+                            :element-type 'exponent)))
+         ;; otherwise, all exponents are zero
+         (t 
+          (setf (slot-value self 'exponents)
+                (make-array (list new-dimension) :element-type 'exponent :initial-element 0))))))))
+