From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Robert Pluim Newsgroups: gmane.emacs.devel Subject: Re: Making 'eq' == 'eql' in bignum branch Date: Tue, 21 Aug 2018 21:09:09 +0200 Message-ID: <87k1ojv8oa.fsf@gmail.com> References: <29f933ac-a6bf-8742-66a7-0a9d6d3e5a88@disroot.org> <8e0320d9-e0d0-2b57-57cc-2df4399f133c@cs.ucla.edu> <87lgaio7xd.fsf@tromey.com> <877em1cb0i.fsf@tromey.com> <765767b2-d2e5-a9a6-f724-d58ecf4847bb@cs.ucla.edu> <76081b5d-8c10-0a37-2c97-d4864c0faa80@cs.ucla.edu> <09153aed-361d-4f82-d9ac-b502314769ae@cs.ucla.edu> <83k1oldqao.fsf@gnu.org> <87r2irvk5f.fsf@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1534878877 14798 195.159.176.226 (21 Aug 2018 19:14:37 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 21 Aug 2018 19:14:37 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Aug 21 21:14:33 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fsC6n-0003gA-K6 for ged-emacs-devel@m.gmane.org; Tue, 21 Aug 2018 21:14:30 +0200 Original-Received: from localhost ([::1]:55569 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fsC8t-0003HZ-TP for ged-emacs-devel@m.gmane.org; Tue, 21 Aug 2018 15:16:39 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48619) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fsC8c-0003EC-OG for emacs-devel@gnu.org; Tue, 21 Aug 2018 15:16:25 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fsC1n-0001ik-TD for emacs-devel@gnu.org; Tue, 21 Aug 2018 15:09:23 -0400 Original-Received: from mail-wm0-x22b.google.com ([2a00:1450:400c:c09::22b]:52714) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fsC1h-0001dJ-Gj for emacs-devel@gnu.org; Tue, 21 Aug 2018 15:09:15 -0400 Original-Received: by mail-wm0-x22b.google.com with SMTP id y139-v6so1183536wmc.2 for ; Tue, 21 Aug 2018 12:09:13 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:references:mail-followup-to:mail-copies-to :gmane-reply-to-list:date:in-reply-to:message-id:mime-version :content-transfer-encoding; bh=LHI3LJCC5rthH9cFFsyBYH7oS1z/S7J9AdUJa+Yjpe0=; b=OnrMVGM1/SaJS60dT0nUwp9lduCNoFj+GPe+MqevglhcHcdfmYp3IXGZYWP7XiwfAJ 8Tj7FwZVBIaKH6xCLylA/vIDwjwXzaN8g3Xkx44IpOhugiG5/IbeE2NYUaoK4pGJoi4S hhy/1wkY6SXTQsBWof3A+4MQJAfEphp+/U5Gaet/d3xSmAO3UiKVD1+l0crFUDghNR5M IC2iwCMgoi0nrbmJiSwh1eHZ4c6nyXN70IiVbwIqoFplnXtHYC88AWGgCUdgbow1n8+V Qg4oPw/6qgauslhk+iK1Fjfl7PBKFGvcaDZoLAHRgR3t13+2FhRem8O0yMmfNi4pYU+U vXCQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:references:mail-followup-to :mail-copies-to:gmane-reply-to-list:date:in-reply-to:message-id :mime-version:content-transfer-encoding; bh=LHI3LJCC5rthH9cFFsyBYH7oS1z/S7J9AdUJa+Yjpe0=; b=Q7fBLLvsKDMSu34ZuGK9r/IPbwUSvi6iMBSlxj4wGzFAa9yFh+E2Ct8YZ5g5vGYoKN hZzAmKJ0n+HPb3Jp8Jpo/E5xIarqqWA/OjonwLOuj0hWTe/af1by8bHv491DN2OjDfG1 a9yoCYjc8kQsFTp0KdFIH17Qo5dTUZ4DoJ2/EjE9xBzw8kjxMM6Hl4ZwczuywDyQMznJ TgmIogjS+lD1s8xxsedrrnEqDwt9tUPQ6r4VZ3osVPrtvniUZuhwhocVocC0GJZ9ij08 Nqo6V9BzijamZzV9NLFKcoEKtJUwHLjRFFlUVLdfL8ZQNn0YaI1lv8UqlunvrImkqca9 q3dw== X-Gm-Message-State: APzg51C6nLsA1dsmOaf4FOfXHxvqTP1guAx7ZxX+Ha9LuxZ0UvQtfWb2 uUzdqvTP4ZkN8/6EqNv4wGA1lWn7 X-Google-Smtp-Source: ANB0VdZ2fryGdMMQBdjyO4qxZVGgMpv1IuJEjk0q8tPSeWzuqf53c7CZsn9Y2GL3ViGfE6GxLfj/xg== X-Received: by 2002:a1c:14c3:: with SMTP id 186-v6mr388624wmu.21.1534878551607; Tue, 21 Aug 2018 12:09:11 -0700 (PDT) Original-Received: from rpluim-ubuntu (vav06-1-78-207-202-134.fbx.proxad.net. [78.207.202.134]) by smtp.gmail.com with ESMTPSA id d12-v6sm15393304wru.36.2018.08.21.12.09.09 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 21 Aug 2018 12:09:10 -0700 (PDT) Mail-Followup-To: emacs-devel@gnu.org Mail-Copies-To: never Gmane-Reply-To-List: yes In-Reply-To: <87r2irvk5f.fsf@gmail.com> (Robert Pluim's message of "Tue, 21 Aug 2018 17:01:16 +0200") X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:400c:c09::22b X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:228792 Archived-At: Robert Pluim writes: > Stefan Monnier 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 bign= ums? > > 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=CA=BCs faster, but haven=CA=BCt 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 (=3D (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) (=3D 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)))) =20 -(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)))) =20 -(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)))))) =20 (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)))) =20 -(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)))))) =20 (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)))) =20 -(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)))))) =20 (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)))) =20 -(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))))))) =20 (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)))))) =20 -(defun math-not-bignum (a w) ; [l l] - (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) - (if (<=3D 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))= )))) =20 (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 =20 ;;; True if A is an odd integer. [P R R] [Public] (defun math-oddp (a) - (if (consp a) - (and (memq (car a) '(bigpos bigneg)) - (=3D (% (nth 1 a) 2) 1)) - (/=3D (% a 2) 0))) + (/=3D (% a 2) 0)) =20 ;;; 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)) =20 ;;; 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)) =20 ;;; 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))) =20 ;;; 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)))) =20 ;;; 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)))) =20 ;;; 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)))) =20 ;;; 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)))) =20 ;;; 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)))) =20 ;;; 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)))) =20 ;;; True if A is numerically (but not literally) an integer. [P x] [Publi= c] @@ -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)) (>=3D (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)))) =20 ;;; Verify that A is an integer and return A in integer form. [I N; - x] @@ -2348,13 +2342,7 @@ math-contains-sdev-p =20 ;;; 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) =20 (defun math-fixnum-big (a) (if (cdr a) @@ -2469,12 +2457,6 @@ math-norm-bignum (setcdr last nil) a)))) =20 -(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)) - =20 (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))) =20 (defsubst Math-integer-negp (a) - (if (consp a) - (eq (car a) 'bigneg) - (< a 0))) + (< a 0)) =20 (defsubst Math-integer-posp (a) - (if (consp a) - (eq (car a) 'bigpos) - (> a 0))) + (> a 0)) =20 (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))) =20 (defsubst Math-looks-negp (a) ; [P x] [Public] @@ -104,41 +94,38 @@ Math-looks-negp =20 (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))) =20 (defsubst Math-integerp (a) - (or (not (consp a)) - (memq (car a) '(bigpos bigneg)))) + (not (consp a))) =20 (defsubst Math-natnump (a) (if (consp a) - (eq (car a) 'bigpos) + nil (>=3D a 0))) =20 (defsubst Math-ratp (a) (or (not (consp a)) - (memq (car a) '(bigpos bigneg frac)))) + (eq (car a) 'frac))) =20 (defsubst Math-realp (a) (or (not (consp a)) - (memq (car a) '(bigpos bigneg frac float)))) + (memq (car a) '(frac float)))) =20 (defsubst Math-anglep (a) (or (not (consp a)) - (memq (car a) '(bigpos bigneg frac float hms)))) + (memq (car a) '(frac float hms)))) =20 (defsubst Math-numberp (a) (or (not (consp a)) - (memq (car a) '(bigpos bigneg frac float cplx polar)))) + (memq (car a) '(frac float cplx polar)))) =20 (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)))) =20 (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)))) =20 (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)))) =20 ;;; 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)) =20 (defsubst Math-equal (a b) (=3D (math-compare a b) 0)) @@ -175,19 +158,14 @@ Math-lessp =20 (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)))) =20 (defsubst Math-num-integerp (a) (or (not (consp a)) - (memq (car a) '(bigpos bigneg)) (and (eq (car a) 'float) (>=3D (nth 2 a) 0)))) =20 -(defsubst Math-bignum-test (a) ; [B N; B s; b b] - (if (consp a) - a - (math-bignum a))) =20 (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)) - (=3D (% (nth 1 a) 2) 0)) - (=3D (% a 2) 0))) + (=3D (% a 2) 0)) =20 ;; 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)) =20 ;;;###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 (>=3D math-normalize-a math-small-integer-size) - (<=3D 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-n= ormalize-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")))) =20 - - -;; Coerce integer A to be a bignum. [B S] -(defun math-bignum (a) - (cond - ((>=3D a 0) - (cons 'bigpos (math-bignum-big a))) - ((=3D a most-negative-fixnum) - ;; Note: cannot get the negation directly because - ;; (- most-negative-fixnum) is most-negative-fixnum. - ;; - ;; most-negative-fixnum :=3D -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 (=3D 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 =20 (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 (=3D n 0) a - (if (consp a) - (cons (car a) (math-scale-left-bignum (cdr a) n)) - (if (>=3D n math-bignum-digit-length) - (if (or (>=3D a math-bignum-digit-size) - (<=3D 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 (>=3D a sz) (<=3D a (- sz))) - (math-scale-left (math-bignum a) n) - (* a (expt 10 n)))))))) - -(defun math-scale-left-bignum (a n) - (if (>=3D n math-bignum-digit-length) - (while (>=3D (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)))) =20 (defun math-scale-right (a n) ; [i i S] (if (=3D n 0) a - (if (consp a) - (cons (car a) (math-scale-right-bignum (cdr a) n)) - (if (<=3D a 0) - (if (=3D a 0) - 0 - (- (math-scale-right (- a) n))) - (if (>=3D n math-bignum-digit-length) - (while (and (> (setq a (/ a math-bignum-digit-size)) 0) - (>=3D (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 (>=3D 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 (<=3D a 0) + (if (=3D a 0) + 0 + (- (math-scale-right (- a) n))) + (if (> n 0) + (/ a (expt 10 n)) + a)))) =20 ;;; Multiply (with rounding) the integer A by 10^N. [I i S] (defun math-scale-rounding (a n) (cond ((>=3D 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 =3D -math-bignum-digit-len= gth - (if (and val (>=3D (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 (<=3D a (- math-small-integer-size)) (>=3D 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)))) =20 -(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 (>=3D (setq diff (- (car aa) (car b))) 1) - (progn - (setcar aa (1- diff)) - (setq borrow nil)) - (setcar aa (+ diff (1- math-bignum-digit-size)))) - (if (>=3D (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)) =20 (defun math-add-float (a b) ; [F F F] (let ((ediff (- (nth 2 a) (nth 2 b)))) @@ -3100,12 +2891,7 @@ math-add-float =20 ;;; 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 (<=3D a (- math-small-integer-size)) (>=3D a math-small-intege= r-size)) - (math-bignum a) - a))) + (- a b)) =20 (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))) =20 -;;; Multiply digit lists A and B. [L L L; l l l] -(defun math-mul-bignum (a b) - (and a b - (let* ((sum (if (<=3D (car b) 1) - (if (=3D (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 (>=3D 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 (<=3D d 1) - (and (=3D 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 (>=3D prod math-bignum-digit-size) - (setcdr aa (list (/ prod math-bignum-digit-size)))) - a)) - (and (> c 0) - (list c)))) =20 =20 ;;; 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))) =20 (defun math-quotient (a b) ; [I I I] [Public] - (if (and (not (consp a)) (not (consp b))) - (if (=3D b 0) - (math-reject-arg a "*Division by zero") - (/ a b)) - (if (and (natnump b) (< b math-bignum-digit-size)) - (if (=3D 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 (=3D 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 (=3D b 0) + (math-reject-arg a "*Division by zero") + (/ a b))) =20 ;;; 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) (=3D 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))) =20 (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-lengt= h)) - "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)) =20 ;;; 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 (<=3D (length digs) (* 2 math-bignum-digit-length)) - (string-to-number digs) - (cons 'bigpos (math-read-bignum digs)))))) + (string-to-number digs)))) =20 ;; 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 (<=3D (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 (<=3D (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))) =20 -(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))) =20