Changeset 8782


Ignore:
Timestamp:
03/15/05 17:34:10 (16 years ago)
Author:
piso
Message:

Moved Lisp functions to FloatFunctions?.java.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/LispFloat.java

    r8757 r8782  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: LispFloat.java,v 1.85 2005-03-12 17:53:30 piso Exp $
     5 * $Id: LispFloat.java,v 1.86 2005-03-15 17:34:10 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    452452    }
    453453
    454     // ### integer-decode-float
    455     // integer-decode-float float => significand, exponent, integer-sign
    456     private static final Primitive INTEGER_DECODE_FLOAT =
    457         new Primitive("integer-decode-float", "float")
    458     {
    459         public LispObject execute(LispObject arg) throws ConditionThrowable
    460         {
    461             if (arg instanceof LispFloat) {
    462                 LispObject[] values = new LispObject[3];
    463                 long bits =
    464                     Double.doubleToRawLongBits((double)((LispFloat)arg).value);
    465                 int s = ((bits >> 63) == 0) ? 1 : -1;
    466                 int e = (int) ((bits >> 52) & 0x7ffL);
    467                 long m;
    468                 if (e == 0)
    469                     m = (bits & 0xfffffffffffffL) << 1;
    470                 else
    471                     m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
    472                 LispObject significand = number(m);
    473                 Fixnum exponent = new Fixnum(e - 1075);
    474                 Fixnum sign = new Fixnum(s);
    475                 return LispThread.currentThread().setValues(significand,
    476                                                             exponent,
    477                                                             sign);
    478             }
    479             return signal(new TypeError(arg, Symbol.FLOAT));
    480         }
    481     };
    482 
    483454    public LispObject rational() throws ConditionThrowable
    484455    {
     
    508479    }
    509480
    510     // ### rational
    511     private static final Primitive RATIONAL =
    512         new Primitive("rational", "number")
    513     {
    514         public LispObject execute(LispObject arg) throws ConditionThrowable
    515         {
    516             if (arg instanceof LispFloat)
    517                 return ((LispFloat)arg).rational();
    518             if (arg.rationalp())
    519                 return arg;
    520             return signal(new TypeError(arg, Symbol.REAL));
    521         }
    522     };
    523 
    524     // ### float-radix
    525     // float-radix float => float-radix
    526     private static final Primitive FLOAT_RADIX =
    527         new Primitive("float-radix", "float")
    528     {
    529         public LispObject execute(LispObject arg) throws ConditionThrowable
    530         {
    531             if (arg instanceof LispFloat)
    532                 return Fixnum.TWO;
    533             return signal(new TypeError(arg, Symbol.FLOAT));
    534         }
    535     };
    536 
    537     private static final Fixnum FIXNUM_53 = new Fixnum(53);
    538 
    539     // ### float-digits
    540     // float-digits float => float-digits
    541     private static final Primitive FLOAT_DIGITS =
    542         new Primitive("float-digits", "float")
    543     {
    544         public LispObject execute(LispObject arg) throws ConditionThrowable
    545         {
    546             if (arg instanceof LispFloat)
    547                 return FIXNUM_53;
    548             return signal(new TypeError(arg, Symbol.FLOAT));
    549         }
    550     };
    551 
    552     // ### scale-float float integer => scaled-float
    553     private static final Primitive SCALE_FLOAT =
    554         new Primitive("scale-float", "float integer")
    555     {
    556         public LispObject execute(LispObject first, LispObject second)
    557             throws ConditionThrowable
    558         {
    559             double f = getValue(first);
    560             int n = Fixnum.getValue(second);
    561             return new LispFloat(f * Math.pow(2, n));
    562         }
    563     };
    564 
    565481    public static LispFloat coerceToFloat(LispObject obj) throws ConditionThrowable
    566482    {
     
    578494        return null;
    579495    }
    580 
    581     // ### coerce-to-float
    582     private static final Primitive COERCE_TO_FLOAT =
    583         new Primitive("coerce-to-float", PACKAGE_SYS, false)
    584     {
    585         public LispObject execute(LispObject arg) throws ConditionThrowable
    586         {
    587             return coerceToFloat(arg);
    588         }
    589     };
    590 
    591     // ### float
    592     // float number &optional prototype => float
    593     private static final Primitive FLOAT =
    594         new Primitive("float", "number &optional prototype")
    595     {
    596         public LispObject execute(LispObject arg) throws ConditionThrowable
    597         {
    598             return coerceToFloat(arg);
    599         }
    600         public LispObject execute(LispObject first, LispObject second)
    601             throws ConditionThrowable
    602         {
    603             // FIXME Ignore prototype.
    604             return coerceToFloat(first);
    605         }
    606     };
    607 
    608     // ### floatp
    609     // floatp object => generalized-boolean
    610     private static final Primitive FLOATP = new Primitive("floatp", "object")
    611     {
    612         public LispObject execute(LispObject arg) throws ConditionThrowable
    613         {
    614             return arg instanceof LispFloat ? T : NIL;
    615         }
    616     };
    617 
    618     // ### double-float-high-bits
    619     private static final Primitive DOUBLE_FLOAT_HIGH_BITS =
    620         new Primitive("double-float-high-bits", PACKAGE_SYS, false, "float")
    621     {
    622         public LispObject execute(LispObject arg) throws ConditionThrowable
    623         {
    624             if (arg instanceof LispFloat) {
    625                 LispFloat f = (LispFloat) arg;
    626                 return number(Double.doubleToLongBits(f.value) >>> 32);
    627             }
    628             return signal(new TypeError(arg, Symbol.FLOAT));
    629         }
    630     };
    631 
    632     // ### double-float-low-bits
    633     private static final Primitive DOUBLE_FLOAT_LOW_BITS =
    634         new Primitive("double-float-low-bits", PACKAGE_SYS, false, "float")
    635     {
    636         public LispObject execute(LispObject arg) throws ConditionThrowable
    637         {
    638             if (arg instanceof LispFloat) {
    639                 LispFloat f = (LispFloat) arg;
    640                 return number(Double.doubleToLongBits(f.value) & 0xffffffffL);
    641             }
    642             return signal(new TypeError(arg, Symbol.FLOAT));
    643         }
    644     };
    645 
    646     // ### make-double-float bits => float
    647     private static final Primitive MAKE_DOUBLE_FLOAT =
    648         new Primitive("make-double-float", PACKAGE_SYS, false, "bits")
    649     {
    650         public LispObject execute(LispObject arg)
    651             throws ConditionThrowable
    652         {
    653             if (arg instanceof Fixnum) {
    654                 long bits = (long) ((Fixnum)arg).value;
    655                 return new LispFloat(Double.longBitsToDouble(bits));
    656             }
    657             if (arg instanceof Bignum) {
    658                 long bits = ((Bignum)arg).value.longValue();
    659                 return new LispFloat(Double.longBitsToDouble(bits));
    660             }
    661             return signal(new TypeError());
    662         }
    663     };
    664 
    665     private static final Primitive FLOAT_INFINITY_P =
    666         new Primitive("float-infinity-p", PACKAGE_SYS, false)
    667     {
    668         public LispObject execute(LispObject arg)
    669             throws ConditionThrowable
    670         {
    671             if (arg instanceof LispFloat)
    672                 return Double.isInfinite(((LispFloat)arg).value) ? T : NIL;
    673             return signal(new TypeError(arg, Symbol.FLOAT));
    674         }
    675     };
    676 
    677     private static final Primitive FLOAT_NAN_P =
    678         new Primitive("float-nan-p", PACKAGE_SYS, false)
    679     {
    680         public LispObject execute(LispObject arg)
    681             throws ConditionThrowable
    682         {
    683             if (arg instanceof LispFloat)
    684                 return Double.isNaN(((LispFloat)arg).value) ? T : NIL;
    685             return signal(new TypeError(arg, Symbol.FLOAT));
    686         }
    687     };
    688496}
Note: See TracChangeset for help on using the changeset viewer.