Changeset 4537 for branches

Timestamp:

2016-06-18T13:46:17-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/slow-add.lisp (modified) (1 diff)

branches/f4grobner/slow-add.lisp

@@ -35 +35 @@
         (t 
          (rotatef (cdr q) r q))))))
+
+(defun s-add (p q order-fn add-fn &aux result)
+  "Non-recursive version of SLOW-ADD."
+  (loop 
+     (cond
+       ((endp p) (return-from s-add (nreconc result q)))
+       ((endp q) (return-from s-add (nreconc result p)))
+       (t 
+        (multiple-value-bind 
+              (greater-p equal-p)
+            (funcall order-fn (car p) (car q))
+          (cond
+            (greater-p                  ; (> (car p) (car q))
+             (push (pop p) result)
+             )
+            (equal-p                    ; (= (car p)) (car q))
+             (let ((s (funcall add-fn (lc p) (lc q))))
+               (cond 
+                 ((universal-zerop s)
+                  (pop p))
+                 (t 
+                  ;; Adjust the lc of p
+                  (setf (lc p) s)
+                  (push (pop p) result)
+                  )
+                 ))
+             (pop q)
+             )
+            (t      ;(< (car p) (car q))                        
+             (push (pop q) result)
+             )
+            ))))))