1 /* number.h -*- mode:c; coding:utf-8; -*- 2 * 3 * Copyright (c) 2010-2021 Takashi Kato <ktakashi@ymail.com> 4 * 5 * Redistribution and use in source and binary forms, with or without 6 * modification, are permitted provided that the following conditions 7 * are met: 8 * 9 * 1. Redistributions of source code must retain the above copyright 10 * notice, this list of conditions and the following disclaimer. 11 * 12 * 2. Redistributions in binary form must reproduce the above copyright 13 * notice, this list of conditions and the following disclaimer in the 14 * documentation and/or other materials provided with the distribution. 15 * 16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 22 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 23 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 24 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 25 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 * 28 * $Id: $ 29 */ 30 #ifndef SAGITTARIUS_PRIVATE_NUMBER_H_ 31 #define SAGITTARIUS_PRIVATE_NUMBER_H_ 32 33 #include "sagittariusdefs.h" 34 #include "clos.h" 35 36 /* classes */ 37 SG_CLASS_DECL(Sg_NumberClass); 38 SG_CLASS_DECL(Sg_ComplexClass); 39 SG_CLASS_DECL(Sg_RealClass); 40 SG_CLASS_DECL(Sg_RationalClass); 41 SG_CLASS_DECL(Sg_IntegerClass); 42 43 #define SG_CLASS_NUMBER (&Sg_NumberClass) 44 #define SG_CLASS_COMPLEX (&Sg_ComplexClass) 45 #define SG_CLASS_REAL (&Sg_RealClass) 46 #define SG_CLASS_RATIONAL (&Sg_RationalClass) 47 #define SG_CLASS_INTEGER (&Sg_IntegerClass) 48 49 SG_CDECL_BEGIN 50 51 struct SgBignumRec 52 { 53 SG_HEADER; 54 long sign : 2; 55 long size: (SIZEOF_LONG*CHAR_BIT-2); 56 unsigned long elements[1]; 57 }; 58 59 #define SG_BIGNUMP(obj) SG_XTYPEP(obj, SG_CLASS_INTEGER) 60 #define SG_BIGNUM(obj) ((SgBignum*)(obj)) 61 62 #define SG_BIGNUM_MAX_DIGITS ((1UL<<(SIZEOF_LONG*CHAR_BIT-2))-1) 63 64 #define SG_BIGNUM_SET_SIGN(obj, s) (SG_BIGNUM(obj)->sign=(s)) 65 66 #define SG_BIGNUM_SET_COUNT(obj, count) (SG_BIGNUM(obj)->size=(count)) 67 68 #define SG_BIGNUM_SET_ZERO(obj) \ 69 (SG_BIGNUM_SET_SIGN(obj, 0), SG_BIGNUM_SET_COUNT(obj, 0)) 70 71 #define SG_BIGNUM_GET_SIGN(obj) (SG_BIGNUM(obj)->sign) 72 #define SG_BIGNUM_GET_COUNT(obj) (SG_BIGNUM(obj)->size) 73 74 struct SgComplexRec 75 { 76 SG_HEADER; 77 SgObject imag; 78 SgObject real; 79 }; 80 81 #define SG_COMPLEXP(obj) SG_XTYPEP(obj, SG_CLASS_COMPLEX) 82 #define SG_COMPLEX(obj) ((SgComplex*)(obj)) 83 84 85 struct SgRationalRec 86 { 87 SG_HEADER; 88 SgObject numerator; 89 SgObject denominator; 90 }; 91 92 #define SG_RATIONALP(obj) SG_XTYPEP(obj, SG_CLASS_RATIONAL) 93 #define SG_RATIONAL(obj) ((SgRational*)(obj)) 94 95 struct SgFlonumRec 96 { 97 SG_HEADER; 98 double value; 99 }; 100 101 #ifdef USE_IMMEDIATE_FLONUM 102 typedef union SgIFlonumRec 103 { 104 #if SIZEOF_VOIDP == 8 105 double f; 106 #else 107 float f; 108 #endif 109 uintptr_t i; 110 } SgIFlonum; 111 #define SG_FLONUMP(obj) (SG_IFLONUMP(obj) || SG_XTYPEP(obj, SG_CLASS_REAL)) 112 #define SG_FLONUM(obj) /* don't use */ 113 #ifdef __GNUC__ 114 #define SG_FLONUM_VALUE(obj) \ 115 (SG_IFLONUMP(obj) \ 116 ? ((double)(((SgIFlonum)((uintptr_t)obj&~SG_IFLONUM_MASK)).f)) \ 117 : ((SgFlonum*)(obj))->value) 118 #else 119 #define SG_FLONUM_VALUE(obj) Sg_FlonumValue(obj) 120 #endif 121 122 SG_EXTERN double Sg_FlonumValue(SgObject obj); 123 #else 124 #define SG_FLONUMP(obj) SG_XTYPEP(obj, SG_CLASS_REAL) 125 #define SG_FLONUM(obj) ((SgFlonum*)(obj)) 126 #define SG_FLONUM_VALUE(obj) (SG_FLONUM(obj)->value) 127 #endif /* USE_IMMEDIATE_FLONUM */ 128 129 /* number type check */ 130 #define SG_EXACT_INTP(obj) ((SG_INTP(obj)) || (SG_BIGNUMP(obj))) 131 #define SG_REALP(obj) ((SG_EXACT_INTP(obj)) || (SG_FLONUMP(obj)) || (SG_RATIONALP(obj))) 132 #define SG_NUMBERP(obj) (SG_REALP(obj) || SG_COMPLEXP(obj)) 133 134 enum ScmClampMode { 135 SG_CLAMP_ERROR = 0, /* throws an error when out-of-range */ 136 SG_CLAMP_HI = 1, 137 SG_CLAMP_LO = 2, 138 SG_CLAMP_BOTH = 3, 139 SG_CLAMP_NONE = 4 /* do not convert when out-of-range */ 140 }; 141 142 #ifdef _MSC_VER 143 /* seems it's defined in VS 12.0 */ 144 # include <math.h> 145 # ifndef isinf 146 # define isinf(x) (!_finite(x) && !_isnan(x)) 147 # endif 148 # ifndef isnan 149 # define isnan(x) _isnan(x) 150 # endif 151 #endif 152 153 SG_EXTERN SgObject Sg_MakeInteger(long x); 154 SG_EXTERN SgObject Sg_MakeIntegerU(unsigned long x); 155 SG_EXTERN SgObject Sg_MakeIntegerFromS64(int64_t x); 156 SG_EXTERN SgObject Sg_MakeIntegerFromU64(uint64_t x); 157 158 #if SIZEOF_LONG >= 8 159 /* if intptr_t is 64 bit, then there is no reason not to fit (u)int32_t */ 160 #define Sg_MakeIntegerFromS32 SG_MAKE_INT 161 #define Sg_MakeIntegerFromU32 SG_MAKE_INT 162 #define Sg_GetIntegerS64Clamp Sg_GetIntegerClamp 163 #define Sg_GetIntegerU64Clamp Sg_GetUIntegerClamp 164 #else 165 #define Sg_MakeIntegerFromS32 Sg_MakeInteger 166 #define Sg_MakeIntegerFromU32 Sg_MakeIntegerU 167 SG_EXTERN int64_t Sg_GetIntegerS64Clamp(SgObject obj, int clamp, int *oor); 168 SG_EXTERN uint64_t Sg_GetIntegerU64Clamp(SgObject obj, int clamp, int *oor); 169 #endif 170 171 SG_EXTERN SgObject Sg_MakeRational(SgObject numerator, SgObject denominator); 172 SG_EXTERN SgObject Sg_MakeFlonum(double d); 173 SG_EXTERN SgObject Sg_MakeComplex(SgObject real, SgObject imag); 174 SG_EXTERN SgObject Sg_MakeComplexPolar(SgObject magnitude, SgObject angle); 175 176 SG_EXTERN long Sg_GetIntegerClamp(SgObject obj, int clamp, int *oor); 177 SG_EXTERN unsigned long Sg_GetUIntegerClamp(SgObject obj, int clamp, int *oor); 178 #define Sg_GetInteger(x) Sg_GetIntegerClamp(x, SG_CLAMP_BOTH, NULL) 179 #define Sg_GetUInteger(x) Sg_GetUIntegerClamp(x, SG_CLAMP_BOTH, NULL) 180 181 SG_EXTERN double Sg_GetDouble(SgObject obj); 182 SG_EXTERN SgObject Sg_DecodeFlonum(double d, int *exp, int *sign); 183 SG_EXTERN SgObject Sg_ReduceRational(SgObject rational); 184 185 /* converter */ 186 SG_EXTERN double Sg_RationalToDouble(SgRational *r); 187 SG_EXTERN SgObject Sg_Numerator(SgObject x); 188 SG_EXTERN SgObject Sg_Denominator(SgObject x); 189 SG_EXTERN SgObject Sg_Rationalize(SgObject x, SgObject e); 190 191 SG_EXTERN SgObject Sg_StringToNumber(SgString *str, int radix, int strict); 192 SG_EXTERN SgObject Sg_NumberToString(SgObject num, int radix, int use_upper); 193 SG_EXTERN int Sg_ZeroP(SgObject obj); 194 SG_EXTERN int Sg_IntegerP(SgObject obj); 195 SG_EXTERN SgObject Sg_Negate(SgObject obj); 196 SG_EXTERN int Sg_NegativeP(SgObject obj); 197 SG_EXTERN int Sg_PositiveP(SgObject obj); 198 SG_EXTERN SgObject Sg_Exact(SgObject obj); 199 SG_EXTERN SgObject Sg_Inexact(SgObject obj); 200 SG_EXTERN int Sg_ExactP(SgObject obj); 201 SG_EXTERN int Sg_InexactP(SgObject obj); 202 SG_EXTERN int Sg_OddP(SgObject obj); 203 SG_EXTERN int Sg_FiniteP(SgObject obj); 204 SG_EXTERN int Sg_InfiniteP(SgObject obj); 205 SG_EXTERN int Sg_NanP(SgObject obj); 206 SG_EXTERN int Sg_RationalP(SgObject obj); 207 SG_EXTERN int Sg_RealValuedP(SgObject n); 208 SG_EXTERN int Sg_RationalValuedP(SgObject n); 209 SG_EXTERN int Sg_IntegerValuedP(SgObject n); 210 211 SG_EXTERN SgObject Sg_Inverse(SgObject obj); 212 213 SG_EXTERN long Sg_IntegerLength(SgObject n); 214 SG_EXTERN SgObject Sg_Ash(SgObject x, long count); 215 SG_EXTERN SgObject Sg_LogNot(SgObject x); 216 SG_EXTERN SgObject Sg_LogAnd(SgObject x, SgObject y); 217 SG_EXTERN SgObject Sg_LogIor(SgObject x, SgObject y); 218 SG_EXTERN SgObject Sg_LogXor(SgObject x, SgObject y); 219 SG_EXTERN long Sg_BitCount(SgObject x); 220 SG_EXTERN long Sg_BitSize(SgObject x); 221 SG_EXTERN long Sg_FirstBitSet(SgObject x); 222 SG_EXTERN int Sg_BitSetP(SgObject x, long n); 223 224 SG_EXTERN SgObject Sg_Add(SgObject x, SgObject y); 225 SG_EXTERN SgObject Sg_Sub(SgObject x, SgObject y); 226 SG_EXTERN SgObject Sg_Mul(SgObject x, SgObject y); 227 SG_EXTERN SgObject Sg_Div(SgObject x, SgObject y); 228 SG_EXTERN SgObject Sg_Quotient(SgObject x, SgObject y, SgObject *remp); 229 SG_EXTERN SgObject Sg_Modulo(SgObject x, SgObject y, int reminderp); 230 SG_EXTERN SgObject Sg_Expt(SgObject x, SgObject y); 231 SG_EXTERN SgObject Sg_Exp(SgObject obj); 232 SG_EXTERN SgObject Sg_Sin(SgObject obj); 233 SG_EXTERN SgObject Sg_Cos(SgObject obj); 234 SG_EXTERN SgObject Sg_Tan(SgObject obj); 235 SG_EXTERN SgObject Sg_Asin(SgObject obj); 236 SG_EXTERN SgObject Sg_Acos(SgObject obj); 237 SG_EXTERN SgObject Sg_Atan(SgObject obj); 238 SG_EXTERN SgObject Sg_Atan2(SgObject x, SgObject y); 239 SG_EXTERN SgObject Sg_Abs(SgObject obj); 240 SG_EXTERN SgObject Sg_Sqrt(SgObject obj); 241 SG_EXTERN SgObject Sg_ExactIntegerSqrt(SgObject obj); 242 SG_EXTERN int Sg_Sign(SgObject obj); 243 SG_EXTERN SgObject Sg_Gcd(SgObject x, SgObject y); 244 SG_EXTERN SgObject Sg_Magnitude(SgObject obj); 245 SG_EXTERN SgObject Sg_Angle(SgObject obj); 246 SG_EXTERN SgObject Sg_Log(SgObject obj); 247 SG_EXTERN void Sg_MinMax(SgObject arg0, SgObject args, 248 SgObject *min, SgObject *max); 249 SG_EXTERN SgObject Sg_IntegerDiv(SgObject x, SgObject y); 250 SG_EXTERN SgObject Sg_IntegerDiv0(SgObject x, SgObject y); 251 SG_EXTERN SgObject Sg_IntegerMod(SgObject x, SgObject y); 252 SG_EXTERN SgObject Sg_IntegerMod0(SgObject x, SgObject y); 253 254 /* misc */ 255 SG_EXTERN SgObject Sg_ModExpt(SgObject x, SgObject e, SgObject m); 256 SG_EXTERN SgObject Sg_ModInverse(SgObject x, SgObject m); 257 SG_EXTERN SgObject Sg_Square(SgObject x); 258 259 enum SgRoundMode { 260 SG_ROUND_FLOOR, 261 SG_ROUND_CEIL, 262 SG_ROUND_TRUNC, 263 SG_ROUND_ROUND 264 }; 265 SG_EXTERN SgObject Sg_Round(SgObject num, int mode); 266 267 SG_EXTERN int Sg_NumEq(SgObject x, SgObject y); 268 SG_EXTERN int Sg_NumCmp(SgObject x, SgObject y); 269 SG_EXTERN int Sg_NumGt(SgObject x, SgObject y); 270 SG_EXTERN int Sg_NumGe(SgObject x, SgObject y); 271 SG_EXTERN int Sg_NumLt(SgObject x, SgObject y); 272 SG_EXTERN int Sg_NumLe(SgObject x, SgObject y); 273 274 SG_CDECL_END 275 276 #endif /* SAGITTARIUS_NUMBER_H_ */ 277 278 /* 279 end of file 280 Local Variables: 281 coding: utf-8-unix 282 End: 283 */ 284