source: branches/streams/abcl/src/org/armedbear/lisp/Complex.java

Last change on this file was 14757, checked in by Mark Evenson, 10 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.