0.8.3.5:

[sbcl.git] / src / code / numbers.lisp

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index b298f9f..a62eb9d 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -211,10 +211,11 @@
 \f
 ;;;; COMPLEXes
 
 \f
 ;;;; COMPLEXes
 

-(defun upgraded-complex-part-type (spec)
+(defun upgraded-complex-part-type (spec &optional environment)

   #!+sb-doc
   "Return the element type of the most specialized COMPLEX number type that
    can hold parts of type SPEC."
   #!+sb-doc
   "Return the element type of the most specialized COMPLEX number type that
    can hold parts of type SPEC."

+  (declare (ignore environment))

   (cond ((unknown-type-p (specifier-type spec))
         (error "undefined type: ~S" spec))
        ((subtypep spec 'single-float)
   (cond ((unknown-type-p (specifier-type spec))
         (error "undefined type: ~S" spec))
        ((subtypep spec 'single-float)

@@ -577,7 +578,7 @@
                          (numerator divisor))))
         (values q (- number (* q divisor)))))
       ((fixnum bignum)
                          (numerator divisor))))
         (values q (- number (* q divisor)))))
       ((fixnum bignum)

-       (values 0 number))
+       (bignum-truncate (make-small-bignum number) divisor))

       ((ratio (or float rational))
        (let ((q (truncate (numerator number)
                          (* (denominator number) divisor))))
       ((ratio (or float rational))
        (let ((q (truncate (numerator number)
                          (* (denominator number) divisor))))

@@ -1335,3 +1336,30 @@
   (def minusp "Is this real number strictly negative?")
   (def oddp "Is this integer odd?")
   (def evenp "Is this integer even?"))
   (def minusp "Is this real number strictly negative?")
   (def oddp "Is this integer odd?")
   (def evenp "Is this integer even?"))

+\f
+;;;; modular functions
+#.
+(collect ((forms))
+  (flet ((definition (name lambda-list width pattern)
+           ;; We rely on (SUBTYPEP `(UNSIGNED-BYTE ,WIDTH)
+           ;;                      'BIGNUM-ELEMENT-TYPE)
+           `(defun ,name ,lambda-list
+              (flet ((prepare-argument (x)
+                       (declare (integer x))
+                       (etypecase x
+                         ((unsigned-byte ,width) x)
+                         (bignum-element-type (logand x ,pattern))
+                         (fixnum (logand x ,pattern))
+                         (bignum (logand (%bignum-ref x 0) ,pattern)))))
+                (,name ,@(loop for arg in lambda-list
+                               collect `(prepare-argument ,arg)))))))
+    (loop for infos being each hash-value of sb!c::*modular-funs*
+          ;; FIXME: We need to process only "toplevel" functions
+          unless (eq infos :good)
+          do (loop for info in infos
+                   for name = (sb!c::modular-fun-info-name info)
+                   and width = (sb!c::modular-fun-info-width info)
+                   and lambda-list = (sb!c::modular-fun-info-lambda-list info)
+                   for pattern = (1- (ash 1 width))
+                   do (forms (definition name lambda-list width pattern)))))
+  `(progn ,@(forms)))