[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv6080

Modified Files:
	integers.lisp 
Log Message:
Improved ratio support in +, -, truncate, and compare.

Date: Fri Jul 30 15:10:59 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.88 movitz/losp/muerte/integers.lisp:1.89
--- movitz/losp/muerte/integers.lisp:1.88	Fri Jul 30 14:06:27 2004
+++ movitz/losp/muerte/integers.lisp	Fri Jul 30 15:10:59 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: integers.lisp,v 1.88 2004/07/30 21:06:27 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.89 2004/07/30 22:10:59 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -690,14 +690,10 @@
 		 (- x (- y)))
 		(((integer * -1) (integer * -1))
 		 (%negatef (+ (- x) (- y)) x y))
-		((ratio t)
-		 (make-rational (+ (* (ratio-numerator x) (denominator y))
-				   (* (numerator y) (ratio-denominator x)))
-				(* (ratio-denominator x) (denominator y))))
-		((integer ratio)
-		 (make-rational (+ (* x (denominator y))
-				   (* (ratio-numerator y) x))
-				(denominator y)))
+		((rational rational)
+		 (/ (+ (* (numerator x) (denominator y))
+		       (* (numerator y) (denominator x)))
+		    (* (denominator x) (denominator y))))
 		)))
 	(do-it)))
    (t (&rest terms)
@@ -728,7 +724,10 @@
 			(:testb 7 :cl)
 			(:jnz '(:sub-program (not-a-number)
 				(:compile-form (:result-mode :ignore)
-				 (error 'type-error :expected-type 'number :datum x))))
+				 (if (ratio-p x)
+				     (make-rational (- (ratio-numerator x))
+				      (ratio-denominator x))
+				   (error 'type-error :expected-type 'number :datum x)))))
 			(:movl (:eax ,movitz:+other-type-offset+) :ecx)
 			(:cmpb ,(movitz:tag :bignum) :cl)
 			(:jne 'not-a-number)
@@ -834,6 +833,10 @@
 		 (%negatef (+ (- minuend) subtrahend) minuend subtrahend))
 		(((integer * -1) (integer * -1))
 		 (+ minuend (- subtrahend)))
+		((rational rational)
+		 (/ (- (* (numerator minuend) (denominator subtrahend))
+		       (* (numerator subtrahend) (denominator minuend)))
+		    (* (denominator minuend) (denominator subtrahend))))
 		)))
 	(do-it)))
    (t (minuend &rest subtrahends)
@@ -1218,7 +1221,12 @@
    (t (number divisor)
       (number-double-dispatch (number divisor)
 	((t (eql 1))
-	 (values number 0))
+	 (if (not (ratio-p number))
+	     (values number 0)
+	   (multiple-value-bind (q r)
+	       (truncate (ratio-numerator number)
+			 (ratio-denominator number))
+	     (values q (make-rational r (ratio-denominator number))))))
 	((fixnum fixnum)
 	 (with-inline-assembly (:returns :multiple-values)
 	   (:compile-form (:result-mode :eax) number)