[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Making 'eq' == 'eql' in bignum branch
|
From: |
Robert Pluim |
|
Subject: |
Re: Making 'eq' == 'eql' in bignum branch |
|
Date: |
Tue, 21 Aug 2018 21:09:09 +0200 |
Robert Pluim <address@hidden> writes:
> Stefan Monnier <address@hidden> writes:
>
>>> I don't think we should go as far as removing these functions, as they
>>> can still be useful in some situations. Let's not rush.
>>
>> Agreed. How 'bout we first try to actually make use of bignums?
>> E.g. changing Calc to use them instead of its own implementation of bignums?
>
> That probably wouldn't be too hard. Any suggestions for what kind of
> tests you'd want of the result?
First rough cut attached. It works for basic arithmetic stuff, but
still has bugs, eg when using trigonometric functions. I assume itʼs
faster, but havenʼt measured it.
diff --git i/lisp/calc/calc-aent.el w/lisp/calc/calc-aent.el
index 93aacac8cb..4e58ce8ec2 100644
--- i/lisp/calc/calc-aent.el
+++ w/lisp/calc/calc-aent.el
@@ -82,7 +82,7 @@ calc-do-quick-calc
" ")
shortbuf buf)
(if (and (= (length alg-exp) 1)
- (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
+; (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
(< (length buf) 20)
(= calc-number-radix 10))
(setq buf (concat buf " ("
diff --git i/lisp/calc/calc-alg.el w/lisp/calc/calc-alg.el
index 7a448d20ec..2440155ae5 100644
--- i/lisp/calc/calc-alg.el
+++ w/lisp/calc/calc-alg.el
@@ -258,9 +258,9 @@ math-beforep
(and (eq comp 0)
(not (equal a b))
(> (length (memq (car-safe a)
- '(bigneg nil bigpos frac float)))
+ '(nil frac float)))
(length (memq (car-safe b)
- '(bigneg nil bigpos frac float))))))))
+ '(nil frac float))))))))
((equal b '(neg (var inf var-inf))) nil)
((equal a '(neg (var inf var-inf))) t)
((equal a '(var inf var-inf)) nil)
diff --git i/lisp/calc/calc-bin.el w/lisp/calc/calc-bin.el
index c05a71a2d7..253e632dee 100644
--- i/lisp/calc/calc-bin.el
+++ w/lisp/calc/calc-bin.el
@@ -273,14 +273,6 @@ calcFunc-and
(math-binary-arg b w)))
w))))
-(defun math-binary-arg (a w)
- (if (not (Math-integerp a))
- (setq a (math-trunc a)))
- (if (Math-integer-negp a)
- (math-not-bignum (cdr (math-bignum-test (math-sub -1 a)))
- (math-abs (if w (math-trunc w) calc-word-size)))
- (cdr (Math-bignum-test a))))
-
(defun math-binary-modulo-args (f a b w)
(let (mod)
(if (eq (car-safe a) 'mod)
@@ -310,14 +302,6 @@ math-binary-modulo-args
(funcall f a w))
mod))))
-(defun math-and-bignum (a b) ; [l l l]
- (and a b
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logand (cdr qa) (cdr qb))))))
(defun calcFunc-or (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
@@ -337,14 +321,6 @@ calcFunc-or
(math-binary-arg b w)))
w))))
-(defun math-or-bignum (a b) ; [l l l]
- (and (or a b)
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logior (cdr qa) (cdr qb))))))
(defun calcFunc-xor (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
@@ -364,14 +340,6 @@ calcFunc-xor
(math-binary-arg b w)))
w))))
-(defun math-xor-bignum (a b) ; [l l l]
- (and (or a b)
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logxor (cdr qa) (cdr qb))))))
(defun calcFunc-diff (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
@@ -391,14 +359,6 @@ calcFunc-diff
(math-binary-arg b w)))
w))))
-(defun math-diff-bignum (a b) ; [l l l]
- (and a
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logand (cdr qa) (lognot (cdr qb)))))))
(defun calcFunc-not (a &optional w) ; [I I] [Public]
(cond ((Math-messy-integerp w)
@@ -416,16 +376,6 @@ calcFunc-not
(math-not-bignum (math-binary-arg a w)
w))))))
-(defun math-not-bignum (a w) ; [l l]
- (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
- (if (<= w math-bignum-logb-digit-size)
- (list (logand (lognot (cdr q))
- (1- (lsh 1 w))))
- (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
- (- w
math-bignum-logb-digit-size))
- math-bignum-digit-power-of-two
- (logxor (cdr q)
- (1- math-bignum-digit-power-of-two))))))
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
(setq a (math-trunc a)
diff --git i/lisp/calc/calc-ext.el w/lisp/calc/calc-ext.el
index 5feff23f72..5922ce0acf 100644
--- i/lisp/calc/calc-ext.el
+++ w/lisp/calc/calc-ext.el
@@ -2116,45 +2116,40 @@ math-expand-formulas
;;; True if A is an odd integer. [P R R] [Public]
(defun math-oddp (a)
- (if (consp a)
- (and (memq (car a) '(bigpos bigneg))
- (= (% (nth 1 a) 2) 1))
- (/= (% a 2) 0)))
+ (/= (% a 2) 0))
;;; True if A is a small or big integer. [P x] [Public]
(defun math-integerp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg))))
+ (integerp a))
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
(defun math-natnump (a)
- (or (natnump a)
- (eq (car-safe a) 'bigpos)))
+ (natnump a))
;;; True if A is a rational (or integer). [P x] [Public]
(defun math-ratp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac))))
+ (eq (car-safe a) 'frac)))
;;; True if A is a real (or rational). [P x] [Public]
(defun math-realp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float))))
+ (memq (car-safe a) '(frac float))))
;;; True if A is a real or HMS form. [P x] [Public]
(defun math-anglep (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float hms))))
+ (memq (car-safe a) '(frac float hms))))
;;; True if A is a number of any kind. [P x] [Public]
(defun math-numberp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
+ (memq (car-safe a) '(frac float cplx polar))))
;;; True if A is a complex number or angle. [P x] [Public]
(defun math-scalarp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
+ (memq (car-safe a) '(frac float cplx polar hms))))
;;; True if A is a vector. [P x] [Public]
(defun math-vectorp (a)
@@ -2163,13 +2158,13 @@ math-vectorp
;;; True if A is any vector or scalar data object. [P x]
(defun math-objvecp (a) ; [Public]
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar
+ (memq (car-safe a) '(frac float cplx polar
hms date sdev intv mod vec incomplete))))
;;; True if A is an object not composed of sub-formulas . [P x] [Public]
(defun math-primp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar
+ (memq (car-safe a) '(frac float cplx polar
hms date mod var))))
;;; True if A is numerically (but not literally) an integer. [P x] [Public]
@@ -2186,7 +2181,6 @@ math-num-integerp
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
(defun math-num-natnump (a)
(or (natnump a)
- (eq (car-safe a) 'bigpos)
(and (eq (car-safe a) 'float)
(Math-natnump (nth 1 a))
(>= (nth 2 a) 0))))
@@ -2276,7 +2270,7 @@ math-ident-row-p
;;; True if A is any scalar data object. [P x]
(defun math-objectp (a) ; [Public]
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx
+ (memq (car-safe a) '(frac float cplx
polar hms date sdev intv mod))))
;;; Verify that A is an integer and return A in integer form. [I N; - x]
@@ -2348,13 +2342,7 @@ math-contains-sdev-p
;;; Coerce integer A to be a small integer. [S I]
(defun math-fixnum (a)
- (if (consp a)
- (if (cdr a)
- (if (eq (car a) 'bigneg)
- (- (math-fixnum-big (cdr a)))
- (math-fixnum-big (cdr a)))
- 0)
- a))
+ a)
(defun math-fixnum-big (a)
(if (cdr a)
@@ -2469,12 +2457,6 @@ math-norm-bignum
(setcdr last nil)
a))))
-(defun math-bignum-test (a) ; [B N; B s; b b]
- (if (consp a)
- a
- (math-bignum a)))
-
-
;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
(defun calcFunc-sign (a &optional x)
(let ((signs (math-possible-signs a)))
diff --git i/lisp/calc/calc-macs.el w/lisp/calc/calc-macs.el
index 0a1f552840..8c68e30e6b 100644
--- i/lisp/calc/calc-macs.el
+++ w/lisp/calc/calc-macs.el
@@ -29,9 +29,6 @@
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
-(declare-function math-bignum "calc" (a))
-(declare-function math-compare-bignum "calc-ext" (a b))
-
(defmacro calc-wrapper (&rest body)
`(calc-do (function (lambda ()
@@ -70,29 +67,22 @@ calc-with-trail-buffer
;;; Faster in-line version zerop, normalized values only.
(defsubst Math-zerop (a) ; [P N]
(if (consp a)
- (and (not (memq (car a) '(bigpos bigneg)))
- (if (eq (car a) 'float)
- (eq (nth 1 a) 0)
- (math-zerop a)))
+ (if (eq (car a) 'float)
+ (eq (nth 1 a) 0)
+ (math-zerop a))
(eq a 0)))
(defsubst Math-integer-negp (a)
- (if (consp a)
- (eq (car a) 'bigneg)
- (< a 0)))
+ (< a 0))
(defsubst Math-integer-posp (a)
- (if (consp a)
- (eq (car a) 'bigpos)
- (> a 0)))
+ (> a 0))
(defsubst Math-negp (a)
(if (consp a)
- (or (eq (car a) 'bigneg)
- (and (not (eq (car a) 'bigpos))
- (if (memq (car a) '(frac float))
- (Math-integer-negp (nth 1 a))
- (math-negp a))))
+ (if (memq (car a) '(frac float))
+ (Math-integer-negp (nth 1 a))
+ (math-negp a))
(< a 0)))
(defsubst Math-looks-negp (a) ; [P x] [Public]
@@ -104,41 +94,38 @@ Math-looks-negp
(defsubst Math-posp (a)
(if (consp a)
- (or (eq (car a) 'bigpos)
- (and (not (eq (car a) 'bigneg))
- (if (memq (car a) '(frac float))
- (Math-integer-posp (nth 1 a))
- (math-posp a))))
+ (if (memq (car a) '(frac float))
+ (Math-integer-posp (nth 1 a))
+ (math-posp a))
(> a 0)))
(defsubst Math-integerp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg))))
+ (not (consp a)))
(defsubst Math-natnump (a)
(if (consp a)
- (eq (car a) 'bigpos)
+ nil
(>= a 0)))
(defsubst Math-ratp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac))))
+ (eq (car a) 'frac)))
(defsubst Math-realp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float))))
+ (memq (car a) '(frac float))))
(defsubst Math-anglep (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float hms))))
+ (memq (car a) '(frac float hms))))
(defsubst Math-numberp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar))))
+ (memq (car a) '(frac float cplx polar))))
(defsubst Math-scalarp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar hms))))
+ (memq (car a) '(frac float cplx polar hms))))
(defsubst Math-vectorp (a)
(and (consp a) (eq (car a) 'vec)))
@@ -151,21 +138,17 @@ Math-messy-integerp
(defsubst Math-objectp (a) ; [Public]
(or (not (consp a))
(memq (car a)
- '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))
+ '(frac float cplx polar hms date sdev intv mod))))
(defsubst Math-objvecp (a) ; [Public]
(or (not (consp a))
(memq (car a)
- '(bigpos bigneg frac float cplx polar hms date
+ '(frac float cplx polar hms date
sdev intv mod vec))))
;;; Compute the negative of A. [O O; o o] [Public]
(defsubst Math-integer-neg (a)
- (if (consp a)
- (if (eq (car a) 'bigpos)
- (cons 'bigneg (cdr a))
- (cons 'bigpos (cdr a)))
- (- a)))
+ (- a))
(defsubst Math-equal (a b)
(= (math-compare a b) 0))
@@ -175,19 +158,14 @@ Math-lessp
(defsubst Math-primp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar
+ (memq (car a) '(frac float cplx polar
hms date mod var))))
(defsubst Math-num-integerp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg))
(and (eq (car a) 'float)
(>= (nth 2 a) 0))))
-(defsubst Math-bignum-test (a) ; [B N; B s; b b]
- (if (consp a)
- a
- (math-bignum a)))
(defsubst Math-equal-int (a b)
(or (eq a b)
diff --git i/lisp/calc/calc-misc.el w/lisp/calc/calc-misc.el
index 29e8510413..eebfe3834b 100644
--- i/lisp/calc/calc-misc.el
+++ w/lisp/calc/calc-misc.el
@@ -658,10 +658,7 @@ math-concat
;;;###autoload
(defun math-zerop (a)
(if (consp a)
- (cond ((memq (car a) '(bigpos bigneg))
- (while (eq (car (setq a (cdr a))) 0))
- (null a))
- ((memq (car a) '(frac float polar mod))
+ (cond ((memq (car a) '(frac float polar mod))
(math-zerop (nth 1 a)))
((eq (car a) 'cplx)
(and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
@@ -677,9 +674,7 @@ math-zerop
;;;###autoload
(defun math-negp (a)
(if (consp a)
- (cond ((eq (car a) 'bigpos) nil)
- ((eq (car a) 'bigneg) (cdr a))
- ((memq (car a) '(float frac))
+ (cond ((memq (car a) '(float frac))
(Math-integer-negp (nth 1 a)))
((eq (car a) 'hms)
(if (math-zerop (nth 1 a))
@@ -712,9 +707,7 @@ math-looks-negp
;;;###autoload
(defun math-posp (a)
(if (consp a)
- (cond ((eq (car a) 'bigpos) (cdr a))
- ((eq (car a) 'bigneg) nil)
- ((memq (car a) '(float frac))
+ (cond ((memq (car a) '(float frac))
(Math-integer-posp (nth 1 a)))
((eq (car a) 'hms)
(if (math-zerop (nth 1 a))
@@ -742,20 +735,13 @@ 'math-fixnatnump
;; True if A is an even integer. [P R R] [Public]
;;;###autoload
(defun math-evenp (a)
- (if (consp a)
- (and (memq (car a) '(bigpos bigneg))
- (= (% (nth 1 a) 2) 0))
- (= (% a 2) 0)))
+ (= (% a 2) 0))
;; Compute A / 2, for small or big integer A. [I i]
;; If A is negative, type of truncation is undefined.
;;;###autoload
(defun math-div2 (a)
- (if (consp a)
- (if (cdr a)
- (math-normalize (cons (car a) (math-div2-bignum (cdr a))))
- 0)
- (/ a 2)))
+ (/ a 2))
;;;###autoload
(defun math-div2-bignum (a) ; [l l]
diff --git i/lisp/calc/calc.el w/lisp/calc/calc.el
index 4bebd5f47b..cdf4580dde 100644
--- i/lisp/calc/calc.el
+++ w/lisp/calc/calc.el
@@ -2627,42 +2627,7 @@ math-normalize
(setq math-normalize-error nil)
(cond
((not (consp math-normalize-a))
- (if (integerp math-normalize-a)
- (if (or (>= math-normalize-a math-small-integer-size)
- (<= math-normalize-a (- math-small-integer-size)))
- (math-bignum math-normalize-a)
- math-normalize-a)
- math-normalize-a))
- ((eq (car math-normalize-a) 'bigpos)
- (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
- (let* ((last (setq math-normalize-a
- (copy-sequence math-normalize-a))) (digs
math-normalize-a))
- (while (setq digs (cdr digs))
- (or (eq (car digs) 0) (setq last digs)))
- (setcdr last nil)))
- (if (cdr (cdr (cdr math-normalize-a)))
- math-normalize-a
- (cond
- ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a)
- math-bignum-digit-size)))
- ((cdr math-normalize-a) (nth 1 math-normalize-a))
- (t 0))))
- ((eq (car math-normalize-a) 'bigneg)
- (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
- (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a)))
- (digs math-normalize-a))
- (while (setq digs (cdr digs))
- (or (eq (car digs) 0) (setq last digs)))
- (setcdr last nil)))
- (if (cdr (cdr (cdr math-normalize-a)))
- math-normalize-a
- (cond
- ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a)
- math-bignum-digit-size))))
- ((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
- (t 0))))
+ math-normalize-a)
((eq (car math-normalize-a) 'float)
(math-make-float (math-normalize (nth 1 math-normalize-a))
(nth 2 math-normalize-a)))
@@ -2774,30 +2739,6 @@ math-check-complete
((consp a) a)
(t (error "Invalid data object encountered"))))
-
-
-;; Coerce integer A to be a bignum. [B S]
-(defun math-bignum (a)
- (cond
- ((>= a 0)
- (cons 'bigpos (math-bignum-big a)))
- ((= a most-negative-fixnum)
- ;; Note: cannot get the negation directly because
- ;; (- most-negative-fixnum) is most-negative-fixnum.
- ;;
- ;; most-negative-fixnum := -most-positive-fixnum - 1
- (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum))
- 1))
- (t
- (cons 'bigneg (math-bignum-big (- a))))))
-
-(defun math-bignum-big (a) ; [L s]
- (if (= a 0)
- nil
- (cons (% a math-bignum-digit-size)
- (math-bignum-big (/ a math-bignum-digit-size)))))
-
-
;; Build a normalized floating-point number. [F I S]
(defun math-make-float (mant exp)
(if (eq mant 0)
@@ -2847,8 +2788,6 @@ math-float
(defun math-neg (a)
(cond ((not (consp a)) (- a))
- ((eq (car a) 'bigpos) (cons 'bigneg (cdr a)))
- ((eq (car a) 'bigneg) (cons 'bigpos (cdr a)))
((memq (car a) '(frac float))
(list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
((memq (car a) '(cplx vec hms date calcFunc-idn))
@@ -2881,76 +2820,23 @@ math-scale-int
(defun math-scale-left (a n) ; [I I S]
(if (= n 0)
a
- (if (consp a)
- (cons (car a) (math-scale-left-bignum (cdr a) n))
- (if (>= n math-bignum-digit-length)
- (if (or (>= a math-bignum-digit-size)
- (<= a (- math-bignum-digit-size)))
- (math-scale-left (math-bignum a) n)
- (math-scale-left (* a math-bignum-digit-size)
- (- n math-bignum-digit-length)))
- (let ((sz (expt 10 (- (* 2 math-bignum-digit-length) n))))
- (if (or (>= a sz) (<= a (- sz)))
- (math-scale-left (math-bignum a) n)
- (* a (expt 10 n))))))))
-
-(defun math-scale-left-bignum (a n)
- (if (>= n math-bignum-digit-length)
- (while (>= (setq a (cons 0 a)
- n (- n math-bignum-digit-length))
- math-bignum-digit-length)))
- (if (> n 0)
- (math-mul-bignum-digit a (expt 10 n) 0)
- a))
+ (* a (expt 10 n))))
(defun math-scale-right (a n) ; [i i S]
(if (= n 0)
a
- (if (consp a)
- (cons (car a) (math-scale-right-bignum (cdr a) n))
- (if (<= a 0)
- (if (= a 0)
- 0
- (- (math-scale-right (- a) n)))
- (if (>= n math-bignum-digit-length)
- (while (and (> (setq a (/ a math-bignum-digit-size)) 0)
- (>= (setq n (- n math-bignum-digit-length))
- math-bignum-digit-length))))
- (if (> n 0)
- (/ a (expt 10 n))
- a)))))
-
-(defun math-scale-right-bignum (a n) ; [L L S; l l S]
- (if (>= n math-bignum-digit-length)
- (setq a (nthcdr (/ n math-bignum-digit-length) a)
- n (% n math-bignum-digit-length)))
- (if (> n 0)
- (cdr (math-mul-bignum-digit a (expt 10 (- math-bignum-digit-length n))
0))
- a))
+ (if (<= a 0)
+ (if (= a 0)
+ 0
+ (- (math-scale-right (- a) n)))
+ (if (> n 0)
+ (/ a (expt 10 n))
+ a))))
;;; Multiply (with rounding) the integer A by 10^N. [I i S]
(defun math-scale-rounding (a n)
(cond ((>= n 0)
(math-scale-left a n))
- ((consp a)
- (math-normalize
- (cons (car a)
- (let ((val (if (< n (- math-bignum-digit-length))
- (math-scale-right-bignum
- (cdr a)
- (- (- math-bignum-digit-length) n))
- (if (< n 0)
- (math-mul-bignum-digit
- (cdr a)
- (expt 10 (+ math-bignum-digit-length n)) 0)
- (cdr a))))) ; n = -math-bignum-digit-length
- (if (and val (>= (car val) (/ math-bignum-digit-size 2)))
- (if (cdr val)
- (if (eq (car (cdr val)) (1- math-bignum-digit-size))
- (math-add-bignum (cdr val) '(1))
- (cons (1+ (car (cdr val))) (cdr (cdr val))))
- '(1))
- (cdr val))))))
(t
(if (< a 0)
(- (math-scale-rounding (- a) n))
@@ -2963,36 +2849,13 @@ math-scale-rounding
(defun math-add (a b)
(or
(and (not (or (consp a) (consp b)))
- (progn
- (setq a (+ a b))
- (if (or (<= a (- math-small-integer-size)) (>= a
math-small-integer-size))
- (math-bignum a)
- a)))
+ (+ a b))
(and (Math-zerop a) (not (eq (car-safe a) 'mod))
(if (and (math-floatp a) (Math-ratp b)) (math-float b) b))
(and (Math-zerop b) (not (eq (car-safe b) 'mod))
(if (and (math-floatp b) (Math-ratp a)) (math-float a) a))
(and (Math-objvecp a) (Math-objvecp b)
(or
- (and (Math-integerp a) (Math-integerp b)
- (progn
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (if (eq (car a) 'bigneg)
- (if (eq (car b) 'bigneg)
- (cons 'bigneg (math-add-bignum (cdr a) (cdr b)))
- (math-normalize
- (let ((diff (math-sub-bignum (cdr b) (cdr a))))
- (if (eq diff 'neg)
- (cons 'bigneg (math-sub-bignum (cdr a) (cdr b)))
- (cons 'bigpos diff)))))
- (if (eq (car b) 'bigneg)
- (math-normalize
- (let ((diff (math-sub-bignum (cdr a) (cdr b))))
- (if (eq diff 'neg)
- (cons 'bigneg (math-sub-bignum (cdr b) (cdr a)))
- (cons 'bigpos diff))))
- (cons 'bigpos (math-add-bignum (cdr a) (cdr b)))))))
(and (Math-ratp a) (Math-ratp b)
(require 'calc-ext)
(calc-add-fractions a b))
@@ -3008,78 +2871,6 @@ math-add
(and (require 'calc-ext)
(math-add-symb-fancy a b))))
-(defun math-add-bignum (a b) ; [L L L; l l l]
- (if a
- (if b
- (let* ((a (copy-sequence a)) (aa a) (carry nil) sum)
- (while (and aa b)
- (if carry
- (if (< (setq sum (+ (car aa) (car b)))
- (1- math-bignum-digit-size))
- (progn
- (setcar aa (1+ sum))
- (setq carry nil))
- (setcar aa (- sum (1- math-bignum-digit-size))))
- (if (< (setq sum (+ (car aa) (car b))) math-bignum-digit-size)
- (setcar aa sum)
- (setcar aa (- sum math-bignum-digit-size))
- (setq carry t)))
- (setq aa (cdr aa)
- b (cdr b)))
- (if carry
- (if b
- (nconc a (math-add-bignum b '(1)))
- (while (eq (car aa) (1- math-bignum-digit-size))
- (setcar aa 0)
- (setq aa (cdr aa)))
- (if aa
- (progn
- (setcar aa (1+ (car aa)))
- a)
- (nconc a '(1))))
- (if b
- (nconc a b)
- a)))
- a)
- b))
-
-(defun math-sub-bignum (a b) ; [l l l]
- (if b
- (if a
- (let* ((a (copy-sequence a)) (aa a) (borrow nil) diff)
- (while (and aa b)
- (if borrow
- (if (>= (setq diff (- (car aa) (car b))) 1)
- (progn
- (setcar aa (1- diff))
- (setq borrow nil))
- (setcar aa (+ diff (1- math-bignum-digit-size))))
- (if (>= (setq diff (- (car aa) (car b))) 0)
- (setcar aa diff)
- (setcar aa (+ diff math-bignum-digit-size))
- (setq borrow t)))
- (setq aa (cdr aa)
- b (cdr b)))
- (if borrow
- (progn
- (while (eq (car aa) 0)
- (setcar aa (1- math-bignum-digit-size))
- (setq aa (cdr aa)))
- (if aa
- (progn
- (setcar aa (1- (car aa)))
- a)
- 'neg))
- (while (eq (car b) 0)
- (setq b (cdr b)))
- (if b
- 'neg
- a)))
- (while (eq (car b) 0)
- (setq b (cdr b)))
- (and b
- 'neg))
- a))
(defun math-add-float (a b) ; [F F F]
(let ((ediff (- (nth 2 a) (nth 2 b))))
@@ -3100,12 +2891,7 @@ math-add-float
;;; Compute the difference of A and B. [O O O] [Public]
(defun math-sub (a b)
- (if (or (consp a) (consp b))
- (math-add a (math-neg b))
- (setq a (- a b))
- (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size))
- (math-bignum a)
- a)))
+ (- a b))
(defun math-sub-float (a b) ; [F F F]
(let ((ediff (- (nth 2 a) (nth 2 b))))
@@ -3130,8 +2916,6 @@ math-sub-float
(defun math-mul (a b)
(or
(and (not (consp a)) (not (consp b))
- (< a math-bignum-digit-size) (> a (- math-bignum-digit-size))
- (< b math-bignum-digit-size) (> b (- math-bignum-digit-size))
(* a b))
(and (Math-zerop a) (not (eq (car-safe b) 'mod))
(if (Math-scalarp b)
@@ -3145,17 +2929,6 @@ math-mul
(math-mul-zero b a)))
(and (Math-objvecp a) (Math-objvecp b)
(or
- (and (Math-integerp a) (Math-integerp b)
- (progn
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (math-normalize
- (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (if (cdr (cdr a))
- (if (cdr (cdr b))
- (math-mul-bignum (cdr a) (cdr b))
- (math-mul-bignum-digit (cdr a) (nth 1 b) 0))
- (math-mul-bignum-digit (cdr b) (nth 1 a) 0))))))
(and (Math-ratp a) (Math-ratp b)
(require 'calc-ext)
(calc-mul-fractions a b))
@@ -3184,51 +2957,6 @@ math-infinitep
'(var uinf var-uinf)
a)))
-;;; Multiply digit lists A and B. [L L L; l l l]
-(defun math-mul-bignum (a b)
- (and a b
- (let* ((sum (if (<= (car b) 1)
- (if (= (car b) 0)
- (list 0)
- (copy-sequence a))
- (math-mul-bignum-digit a (car b) 0)))
- (sump sum) c d aa ss prod)
- (while (setq b (cdr b))
- (setq ss (setq sump (or (cdr sump) (setcdr sump (list 0))))
- d (car b)
- c 0
- aa a)
- (while (progn
- (setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d))
- c))
- math-bignum-digit-size))
- (setq aa (cdr aa)))
- (setq c (/ prod math-bignum-digit-size)
- ss (or (cdr ss) (setcdr ss (list 0)))))
- (if (>= prod math-bignum-digit-size)
- (if (cdr ss)
- (setcar (cdr ss) (+ (/ prod math-bignum-digit-size) (car
(cdr ss))))
- (setcdr ss (list (/ prod math-bignum-digit-size))))))
- sum)))
-
-;;; Multiply digit list A by digit D. [L L D D; l l D D]
-(defun math-mul-bignum-digit (a d c)
- (if a
- (if (<= d 1)
- (and (= d 1) a)
- (let* ((a (copy-sequence a)) (aa a) prod)
- (while (progn
- (setcar aa
- (% (setq prod (+ (* (car aa) d) c))
- math-bignum-digit-size))
- (cdr aa))
- (setq aa (cdr aa)
- c (/ prod math-bignum-digit-size)))
- (if (>= prod math-bignum-digit-size)
- (setcdr aa (list (/ prod math-bignum-digit-size))))
- a))
- (and (> c 0)
- (list c))))
;;; Compute the integer (quotient . remainder) of A and B, which may be
@@ -3237,93 +2965,12 @@ math-mul-bignum-digit
(defun math-idivmod (a b)
(if (eq b 0)
(math-reject-arg a "*Division by zero"))
- (if (or (consp a) (consp b))
- (if (and (natnump b) (< b math-bignum-digit-size))
- (let ((res (math-div-bignum-digit (cdr a) b)))
- (cons
- (math-normalize (cons (car a) (car res)))
- (cdr res)))
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (let ((res (math-div-bignum (cdr a) (cdr b))))
- (cons
- (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (car res)))
- (math-normalize (cons (car a) (cdr res))))))
- (cons (/ a b) (% a b))))
+ (cons (/ a b) (% a b)))
(defun math-quotient (a b) ; [I I I] [Public]
- (if (and (not (consp a)) (not (consp b)))
- (if (= b 0)
- (math-reject-arg a "*Division by zero")
- (/ a b))
- (if (and (natnump b) (< b math-bignum-digit-size))
- (if (= b 0)
- (math-reject-arg a "*Division by zero")
- (math-normalize (cons (car a)
- (car (math-div-bignum-digit (cdr a) b)))))
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (let* ((alen (1- (length a)))
- (blen (1- (length b)))
- (d (/ math-bignum-digit-size (1+ (nth (1- blen) (cdr b)))))
- (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
- (math-mul-bignum-digit (cdr b) d 0)
- alen blen)))
- (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (car res)))))))
-
-
-;;; Divide a bignum digit list by another. [l.l l L]
-;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1
-(defun math-div-bignum (a b)
- (if (cdr b)
- (let* ((alen (length a))
- (blen (length b))
- (d (/ math-bignum-digit-size (1+ (nth (1- blen) b))))
- (res (math-div-bignum-big (math-mul-bignum-digit a d 0)
- (math-mul-bignum-digit b d 0)
- alen blen)))
- (if (= d 1)
- res
- (cons (car res)
- (car (math-div-bignum-digit (cdr res) d)))))
- (let ((res (math-div-bignum-digit a (car b))))
- (cons (car res) (list (cdr res))))))
-
-;;; Divide a bignum digit list by a digit. [l.D l D]
-(defun math-div-bignum-digit (a b)
- (if a
- (let* ((res (math-div-bignum-digit (cdr a) b))
- (num (+ (* (cdr res) math-bignum-digit-size) (car a))))
- (cons
- (cons (/ num b) (car res))
- (% num b)))
- '(nil . 0)))
-
-(defun math-div-bignum-big (a b alen blen) ; [l.l l L]
- (if (< alen blen)
- (cons nil a)
- (let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen))
- (num (cons (car a) (cdr res)))
- (res2 (math-div-bignum-part num b blen)))
- (cons
- (cons (car res2) (car res))
- (cdr res2)))))
-
-(defun math-div-bignum-part (a b blen) ; a < b*math-bignum-digit-size [D.l
l L]
- (let* ((num (+ (* (or (nth blen a) 0) math-bignum-digit-size)
- (or (nth (1- blen) a) 0)))
- (den (nth (1- blen) b))
- (guess (min (/ num den) (1- math-bignum-digit-size))))
- (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))
-
-(defun math-div-bignum-try (a b c guess) ; [D.l l l D]
- (let ((rem (math-sub-bignum a c)))
- (if (eq rem 'neg)
- (math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
- (cons guess rem))))
-
+ (if (= b 0)
+ (math-reject-arg a "*Division by zero")
+ (/ a b)))
;;; Compute the quotient of A and B. [O O N] [Public]
(defun math-div (a b)
@@ -3548,11 +3195,11 @@ math-format-number
(math-format-binary a)
(math-format-radix a))))
(math-format-radix a))))
- (math-format-number (math-bignum a))))
+ (math-format-bignum a)))
((stringp a) a)
((not (consp a)) (prin1-to-string a))
- ((eq (car a) 'bigpos) (math-format-bignum (cdr a)))
- ((eq (car a) 'bigneg) (concat "-" (math-format-bignum (cdr a))))
+ ((eq (car a) 'bigpos) (error "bignum found"))
+ ((eq (car a) 'bigneg) (error "bignum found"))
((and (eq (car a) 'float) (= calc-number-radix 10))
(if (Math-integer-negp (nth 1 a))
(concat "-" (math-format-number (math-neg a)))
@@ -3642,21 +3289,7 @@ math-format-bignum
(math-format-bignum-fancy a)))
(defun math-format-bignum-decimal (a) ; [X L]
- (if a
- (let ((s ""))
- (while (cdr (cdr a))
- (setq s (concat
- (format
- (concat "%0"
- (number-to-string (* 2 math-bignum-digit-length))
- "d")
- (+ (* (nth 1 a) math-bignum-digit-size) (car a))) s)
- a (cdr (cdr a))))
- (concat (int-to-string
- (+ (* (or (nth 1 a) 0) math-bignum-digit-size) (car a))) s))
- "0"))
-
-
+ (number-to-string a))
;;; Parse a simple number in string form. [N X] [Public]
(defun math-read-number (s &optional decimal)
@@ -3673,9 +3306,7 @@ math-read-number
(eq (aref digs 0) ?0)
(null decimal))
(math-read-number (concat "8#" digs))
- (if (<= (length digs) (* 2 math-bignum-digit-length))
- (string-to-number digs)
- (cons 'bigpos (math-read-bignum digs))))))
+ (string-to-number digs))))
;; Clean up the string if necessary
((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s)
@@ -3730,14 +3361,10 @@ math-read-number-simple
((string-match "^[0-9]+$" s)
(if (string-match "^\\(0+\\)" s)
(setq s (substring s (match-end 0))))
- (if (<= (length s) (* 2 math-bignum-digit-length))
- (string-to-number s)
- (cons 'bigpos (math-read-bignum s))))
+ (string-to-number s))
;; Minus sign
((string-match "^-[0-9]+$" s)
- (if (<= (length s) (1+ (* 2 math-bignum-digit-length)))
- (string-to-number s)
- (cons 'bigneg (math-read-bignum (substring s 1)))))
+ (string-to-number s))
;; Decimal point
((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s)
(let ((int (math-match-substring s 1))
diff --git i/test/lisp/calc/calc-tests.el w/test/lisp/calc/calc-tests.el
index fbd5f0e3a1..6f17ed3691 100644
--- i/test/lisp/calc/calc-tests.el
+++ w/test/lisp/calc/calc-tests.el
@@ -62,12 +62,6 @@ calc-tests-simple
(calc-top-n 1))
(calc-pop 0)))
-(ert-deftest test-math-bignum ()
- ;; bug#17556
- (let ((n (math-bignum most-negative-fixnum)))
- (should (math-negp n))
- (should (cl-notany #'cl-minusp (cdr n)))))
-
(ert-deftest test-calc-remove-units ()
(should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m")
-1)))
- Re: Making 'eq' == 'eql' in bignum branch, (continued)
- Re: Making 'eq' == 'eql' in bignum branch, Eli Zaretskii, 2018/08/20
- Re: Making 'eq' == 'eql' in bignum branch, Paul Eggert, 2018/08/20
- Re: Making 'eq' == 'eql' in bignum branch, Eli Zaretskii, 2018/08/20
- Re: Making 'eq' == 'eql' in bignum branch, Stefan Monnier, 2018/08/20
- Re: Making 'eq' == 'eql' in bignum branch, Eli Zaretskii, 2018/08/20
- Re: Making 'eq' == 'eql' in bignum branch, Robert Pluim, 2018/08/21
- Re: Making 'eq' == 'eql' in bignum branch,
Robert Pluim <=
- Re: Making 'eq' == 'eql' in bignum branch, Paul Eggert, 2018/08/21
- Re: Making 'eq' == 'eql' in bignum branch, Lars Ingebrigtsen, 2018/08/22
- Re: Making 'eq' == 'eql' in bignum branch, Herring, Davis, 2018/08/22
- Re: Making 'eq' == 'eql' in bignum branch, Lars Ingebrigtsen, 2018/08/22
- Re: Making 'eq' == 'eql' in bignum branch, Paul Eggert, 2018/08/22
- Re: Making 'eq' == 'eql' in bignum branch, Stefan Monnier, 2018/08/22
- Re: Making 'eq' == 'eql' in bignum branch, Robert Pluim, 2018/08/23
- Re: Making 'eq' == 'eql' in bignum branch, Eli Zaretskii, 2018/08/23
- Re: Making 'eq' == 'eql' in bignum branch, Robert Pluim, 2018/08/23
- Re: Making 'eq' == 'eql' in bignum branch, Stefan Monnier, 2018/08/23