source: trunk/abcl/src/org/armedbear/lisp/Complex.java

Last change on this file was 14757, checked in by Mark Evenson, 9 years ago

Futher fix for EQUALP on numeric tower

This fixes the following case

(let ((h1 (make-hash-table :test 'equalp))

(h2 (make-hash-table :test 'equalp))
(h (make-hash-table :test 'equalp)))

(setf (gethash 1 h1) 2

(gethash 2 h2) 1
(gethash h1 h) h2
(gethash h2 h) h1)

h)

See <https://mailman.common-lisp.net/pipermail/armedbear-devel/2015-April/003452.html>.
See <http://abcl.org/trac/ticket/388>.

Thanks to Massimiliano Ghilardi.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 8.9 KB
Line 
1/*
2 * Complex.java
3 *
4 * Copyright (C) 2003-2006 Peter Graves
5 * $Id: Complex.java 14757 2015-04-11 07:44:42Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38public final class Complex extends LispObject
39{
40  public final LispObject realpart;
41  public final LispObject imagpart;
42
43  private Complex(LispObject realpart, LispObject imagpart)
44  {
45    this.realpart = realpart;
46    this.imagpart = imagpart;
47  }
48
49  public static LispObject getInstance(LispObject realpart,
50                                       LispObject imagpart)
51
52  {
53    if (!realpart.realp())
54      return type_error(realpart, Symbol.REAL);
55    if (!imagpart.realp())
56      return type_error(imagpart, Symbol.REAL);
57    if (realpart instanceof DoubleFloat)
58      imagpart = DoubleFloat.coerceToFloat(imagpart);
59    else if (imagpart instanceof DoubleFloat)
60      realpart = DoubleFloat.coerceToFloat(realpart);
61    else if (realpart instanceof SingleFloat)
62      imagpart = SingleFloat.coerceToFloat(imagpart);
63    else if (imagpart instanceof SingleFloat)
64      realpart = SingleFloat.coerceToFloat(realpart);
65    if (imagpart instanceof Fixnum)
66      {
67        if (((Fixnum)imagpart).value == 0)
68          return realpart;
69      }
70    return new Complex(realpart, imagpart);
71  }
72
73  public LispObject getRealPart()
74  {
75    return realpart;
76  }
77
78  public LispObject getImaginaryPart()
79  {
80    return imagpart;
81  }
82
83  /** Coerces the complex parts into DoubleFloats
84   *
85   * @return a new complex with double-float real and imaginary parts
86   */
87  public LispObject coerceToDoubleFloat() {
88      return getInstance(DoubleFloat.coerceToFloat(realpart),
89                         DoubleFloat.coerceToFloat(imagpart));
90  }
91
92  @Override
93  public LispObject typeOf()
94  {
95    return Symbol.COMPLEX;
96  }
97
98  @Override
99  public LispObject classOf()
100  {
101    return BuiltInClass.COMPLEX;
102  }
103
104  @Override
105  public LispObject typep(LispObject type)
106  {
107    if (type == Symbol.COMPLEX)
108      return T;
109    if (type == Symbol.NUMBER)
110      return T;
111    if (type == BuiltInClass.COMPLEX)
112      return T;
113    if (type == BuiltInClass.NUMBER)
114      return T;
115    return super.typep(type);
116  }
117
118  @Override
119  public boolean numberp()
120  {
121    return true;
122  }
123
124  @Override
125  public boolean eql(LispObject obj)
126  {
127    if (this == obj)
128      return true;
129    if (obj instanceof Complex)
130      {
131        Complex c = (Complex) obj;
132        return realpart.eql(c.realpart) && imagpart.eql(c.imagpart);
133      }
134    return false;
135  }
136
137  @Override
138  public boolean equal(LispObject obj)
139  {
140    return eql(obj);
141  }
142
143  @Override
144  public boolean equalp(LispObject obj)
145  {
146    if (obj != null && obj.numberp())
147      return isEqualTo(obj);
148    return false;
149  }
150
151  @Override
152  public final LispObject incr()
153  {
154    return new Complex(realpart.add(Fixnum.ONE), imagpart);
155  }
156
157  @Override
158  public final LispObject decr()
159  {
160    return new Complex(realpart.subtract(Fixnum.ONE), imagpart);
161  }
162
163  @Override
164  public LispObject add(LispObject obj)
165  {
166    if (obj instanceof Complex)
167      {
168        Complex c = (Complex) obj;
169        return getInstance(realpart.add(c.realpart), imagpart.add(c.imagpart));
170      }
171    return getInstance(realpart.add(obj), imagpart);
172  }
173
174  @Override
175  public LispObject subtract(LispObject obj)
176  {
177    if (obj instanceof Complex)
178      {
179        Complex c = (Complex) obj;
180        return getInstance(realpart.subtract(c.realpart),
181                           imagpart.subtract(c.imagpart));
182      }
183    return getInstance(realpart.subtract(obj), imagpart);
184  }
185
186  @Override
187  public LispObject multiplyBy(LispObject obj)
188  {
189    if (obj instanceof Complex)
190      {
191        LispObject a = realpart;
192        LispObject b = imagpart;
193        LispObject c = ((Complex)obj).getRealPart();
194        LispObject d = ((Complex)obj).getImaginaryPart();
195        // xy = (ac - bd) + i(ad + bc)
196        // real part = ac - bd
197        // imag part = ad + bc
198        LispObject ac = a.multiplyBy(c);
199        LispObject bd = b.multiplyBy(d);
200        LispObject ad = a.multiplyBy(d);
201        LispObject bc = b.multiplyBy(c);
202        return Complex.getInstance(ac.subtract(bd), ad.add(bc));
203      }
204    return Complex.getInstance(realpart.multiplyBy(obj),
205                               imagpart.multiplyBy(obj));
206  }
207
208  @Override
209  public LispObject divideBy(LispObject obj)
210  {
211    if (obj instanceof Complex)
212      {
213        LispObject a = realpart;
214        LispObject b = imagpart;
215        LispObject c = ((Complex)obj).getRealPart();
216        LispObject d = ((Complex)obj).getImaginaryPart();
217        LispObject ac = a.multiplyBy(c);
218        LispObject bd = b.multiplyBy(d);
219        LispObject bc = b.multiplyBy(c);
220        LispObject ad = a.multiplyBy(d);
221        LispObject denominator = c.multiplyBy(c).add(d.multiplyBy(d));
222        return Complex.getInstance(ac.add(bd).divideBy(denominator),
223                                   bc.subtract(ad).divideBy(denominator));
224      }
225    return Complex.getInstance(realpart.divideBy(obj),
226                               imagpart.divideBy(obj));
227  }
228
229  @Override
230  public boolean isEqualTo(LispObject obj)
231  {
232    if (obj instanceof Complex)
233      {
234        Complex c = (Complex) obj;
235        return (realpart.isEqualTo(c.realpart) &&
236                imagpart.isEqualTo(c.imagpart));
237      }
238    if (obj.numberp())
239      {
240        // obj is a number, but not complex.
241        if (imagpart instanceof SingleFloat)
242          {
243            if (((SingleFloat)imagpart).value == 0)
244              {
245                if (obj instanceof Fixnum)
246                  return ((Fixnum)obj).value == ((SingleFloat)realpart).value;
247                if (obj instanceof SingleFloat)
248                  return ((SingleFloat)obj).value == ((SingleFloat)realpart).value;
249                if (obj instanceof DoubleFloat)
250                  return ((DoubleFloat)obj).value == ((SingleFloat)realpart).value;
251              }
252          }
253        if (imagpart instanceof DoubleFloat)
254          {
255            if (((DoubleFloat)imagpart).value == 0)
256              {
257                if (obj instanceof Fixnum)
258                  return ((Fixnum)obj).value == ((DoubleFloat)realpart).value;
259                if (obj instanceof SingleFloat)
260                  return ((SingleFloat)obj).value == ((DoubleFloat)realpart).value;
261                if (obj instanceof DoubleFloat)
262                  return ((DoubleFloat)obj).value == ((DoubleFloat)realpart).value;
263              }
264          }
265        return false;
266      }
267    type_error(obj, Symbol.NUMBER);
268    // Not reached.
269    return false;
270  }
271
272  @Override
273  public boolean isNotEqualTo(LispObject obj)
274  {
275    return !isEqualTo(obj);
276  }
277
278  @Override
279  public LispObject ABS()
280  {
281    if (realpart.zerop())
282      return imagpart.ABS();
283    double real = DoubleFloat.coerceToFloat(realpart).value;
284    double imag = DoubleFloat.coerceToFloat(imagpart).value;
285    if (realpart instanceof DoubleFloat)
286      return new DoubleFloat(Math.hypot(real, imag));
287    else
288      return new SingleFloat((float)Math.hypot(real, imag));
289  }
290
291  @Override
292  public boolean zerop()
293  {
294    return realpart.zerop() && imagpart.zerop();
295  }
296
297  @Override
298  public LispObject COMPLEXP()
299  {
300    return T;
301  }
302
303  @Override
304  public int sxhash()
305  {
306    return (mix(realpart.sxhash(), imagpart.sxhash()) & 0x7fffffff);
307  }
308
309  @Override
310  public int psxhash()
311  {
312    return (mix(realpart.psxhash(), imagpart.psxhash()) & 0x7fffffff);
313  }
314
315  @Override
316  public String printObject()
317  {
318    StringBuilder sb = new StringBuilder("#C(");
319    sb.append(realpart.printObject());
320    sb.append(' ');
321    sb.append(imagpart.printObject());
322    sb.append(')');
323    return sb.toString();
324  }
325}
Note: See TracBrowser for help on using the repository browser.