Changeset 3315 for branches

Timestamp:

2015-06-23T09:57:00-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/monom.lisp

@@ -81 +81 @@
                                        &allow-other-keys
                                        )
-  (when dimension-supplied-p 
-    (when (and (slot-boundp self 'dimension)
-               (/= (slot-value self 'dimension) dimension))
-      (warn "Changing MONOM DIMENSION from ~A to ~A."
-            (slot-value self 'dimension) dimension))
-    (setf (slot-value self 'dimension) dimension))
-
-  (when exponents-supplied-p
-    (let ((dim (length exponents)))
-      (when (and (slot-boundp self 'dimension)
-                 (/= (slot-value self 'dimension) dim))
-        (warn "Changing slot DIMENSION ~A to match the length of EXPONENTS ~A"
-              (slot-value self 'dimension) (length exponents)))
-      (setf (slot-value self 'dimension) dim
-            (slot-value self 'exponents) (make-array dim :initial-contents exponents)
-            (slot-value self 'dimension) (length exponents))))
-
-  ;; when all exponents are to be identical
-  (if exponent-supplied-p
-    (when (slot-boundp self 'exponents)
-      (warn "Ignoring argument EXPONENT, as slot EXPONENTS already bound."))
-    (cond
-      ((slot-boundp self 'dimension)
-       (let ((dim (slot-value self 'dimension)))
-         (setf (slot-value self 'exponents)
-               (make-array (list dim) :initial-element (if exponent-supplied-p exponent 0)
-                           :element-type 'exponent))))
+  (cond 
+    (exponents-supplied-p
+     (when exponent-supplied-p
+       (warn "Ignoring initarg EXPONENT."))
+     (when dimension-supplied-p
+       (warn "Ignoring initarg DIMENSION."))
+     (let ((dim (length exponents)))
+       (setf (slot-value self 'exponents) (make-array dim :initial-contents exponents))))
+    (exponent-supplied-p
+     ;; when all exponents are to be identical
+     (cond
+       (dimension-supplied-p 
+        (setf (slot-value self 'exponents)
+              (make-array (list dimension) :initial-element (if exponent-supplied-p exponent 0)
+                          :element-type 'exponent))))
       (t  
-       (error "Slot DIMENSION is unbound, but must be known if EXPONENT is supplied.")))))
+       (error "Initarg DIMENSION must be supplied if EXPONENT is supplied.")))))
 
 (defmethod r-equalp ((m1 monom) (m2 monom))