common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Improve intexp around ratios and bignums

Browse source 
Avoiding unnecessary negations.
This commit is contained in:
Stas Boukarev 2026-09-01 04:01:58 +03:00
parent 310019ac0e
commit 695553ac46
2 changed files with 55 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

73
src/code/irrat.lisp
View file

@ -131,41 +131,76 @@
;;; integers, and inverted if negative.
(defun intexp (base power)
(declare (explicit-check))
(cond ((and (eql base 10)
(cond ((not (fixnump power))
(the integer power)
(cond ((eql base 1)
1)
((eql base -1)
(if (evenp power)
1
-1))
((eql base 0)
(cond ((> power 0) 0)
(t (error 'division-by-zero
:operands (list 0 power)
:operation 'expt))))
(t
(error "Exponent too large to fit into memory: ~a" power))))
((and (eql base 10)
(typep power '(integer 0 20)))
(expt 10 power))
((eql base 1)
base)
((eql power 1)
(the (or rational (complex rational)) base))
((eql base -1)
(if (evenp power)
1
base))
-1))
((eql base 0)
(cond ((= power 0) 1)
(cond ((eql power 0) 1)
((> power 0) 0)
(t (error 'division-by-zero
:operands (list 0 power)
:operation 'expt))))
((ratiop base)
(let ((den (denominator base))
(num (numerator base)))
(if (minusp power)
(let ((negated (- power)))
(cond ((eql num 1)
(intexp den negated))
((eql num -1)
(intexp (- den) negated))
(t
(build-ratio (intexp den negated)
(intexp num negated)))))
(build-ratio (intexp num power)
(intexp den power)))))
(let ((num (numerator base))
(den (denominator base)))
(cond ((minusp power)
(let ((negated (- power)))
(cond ((eql num 1)
(intexp den negated))
((eql num -1)
(intexp (- den) negated))
((and (oddp negated)
(minusp num))
;; Avoid negating large bignums
(build-ratio (intexp (- den) negated)
(intexp (- num) negated)))
(t
(build-ratio (intexp den negated)
(intexp num negated))))))
((zerop power)
1)
(t
(%make-ratio (intexp num power)
(intexp den power))))))
((minusp power)
(/ (intexp base (- power))))
(if (integerp base)
(let ((absolute-power (- power)))
(multiple-value-bind (n d)
(if (and (oddp absolute-power)
(minusp base))
(values -1 (intexp (- base) absolute-power))
(values 1 (intexp base absolute-power)))
(%make-ratio n d)))
;; complex rationals
(/ (intexp base (- power)))))
((eql base 2)
(ash 1 power))
((not (fixnump power))
(error "Exponent too large to fit into memory: ~a" power))
((eql base -2)
(ash (if (oddp power) -1 1) power))
(t
(prog ((base base)
(total (if (oddp power) base 1))

2
src/compiler/float-tran.lisp
View file

@ -1103,7 +1103,7 @@
;; complex.
(float-or-complex-float-type (numeric-contagion x y)))))
(defoptimizer (expt derive-type) ((x y))
(defoptimizers derive-type (expt sb-kernel::intexp) ((x y))
(two-arg-derive-type x y #'expt-derive-type-aux))
(defun coerce-float-type (type format)