"Auto-correct" the argument order of R-PROJ-SPACE.

src/special-smsts.lisp

@@ -468,14 +468,39 @@
                               (zero-cmbn (1- degr)))))))
     (the intr-mrph #'rslt)))
 
-(DEFUN R-PROJ-SPACE (&optional (l :infinity) (k 1))
+
-  (declare (fixnum k) (type (or fixnum (eql :infinity))))
+(DEFUN R-PROJ-SPACE (&rest args)
-  (assert
+  (labels ((infinityp (x)
-   (and (typep k 'fixnum)
+             (and (symbolp x)
-        (plusp k)
+                  (eql x :infinity)))
-        (or (eq l :infinity)
+           (dimp (x)
-            (and (typep l 'fixnum)
+             (or (infinityp x)
-                 (<= k l)))))
+                 (and (integerp x)
+                      (< x most-positive-fixnum)
+                      (plusp x)))))
+    (let ((l :infinity)
+          (k 1))
+      ;; accept zero, one or two arguments
+      ;; must be positive FIXNUM or :INFINITY
+      ;; if one is FIXNUM, assign K
+      ;; if both are FIXNUM, sort and assign such that (<= k l)
+      (ecase (length args)
+        (0 t)
+        (1 (let ((a (first args)))
+             (when (dimp a)
+               (unless (infinityp a)
+                   (setq k a)))))
+        (2 (let ((a (first args))
+                 (b (first (last args))))
+             (when (and (and (dimp a)
+                             (dimp b))
+                        (or (not (infinityp a))
+                            (not (infinityp b))))
+               (cond
+                 ((infinityp a) (setq k b))
+                 ((infinityp b) (setq k a))
+                 ((<= a b) (setq l b k a))
+                 (t (setq l a k b)))))))
       (the simplicial-set
            (build-smst
             :cmpr #'R-proj-space-cmpr
@@ -484,7 +509,7 @@
             :face (R-proj-space-face k)
             :intr-bndr (R-proj-space-intr-bndr k)
             :bndr-strt :cmbn
-        :orgn `(R-proj-space ,k ,l))))
+            :orgn `(R-proj-space ,k ,l))))))
 
 
 ;;; Constructing a small simplicial subset