1 /*
2  * ArithmeticProcedures.cpp - arithmetic procedures.
3  *
4  *   Copyright (c) 2008  Higepon(Taro Minowa)  <higepon@users.sourceforge.jp>
5  *   Copyright (c) 2008  Kokosabu(MIURA Yasuyuki)  <kokosabu@gmail.com>
6  *
7  *   Redistribution and use in source and binary forms, with or without
8  *   modification, are permitted provided that the following conditions
9  *   are met:
10  *
11  *   1. Redistributions of source code must retain the above copyright
12  *      notice, this list of conditions and the following disclaimer.
13  *
14  *   2. Redistributions in binary form must reproduce the above copyright
15  *      notice, this list of conditions and the following disclaimer in the
16  *      documentation and/or other materials provided with the distribution.
17  *
18  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29  *
30  *  $Id: ArithmeticProcedures.cpp 183 2008-07-04 06:19:28Z higepon $
31  */
32 
33 #include "Object.h"
34 #include "Object-inl.h"
35 #include "SString.h"
36 #include "Pair.h"
37 #include "Pair-inl.h"
38 #include "ArithmeticProcedures.h"
39 #include "ProcedureMacro.h"
40 #include "Arithmetic.h"
41 #include "Ratnum.h"
42 #include "Fixnum.h"
43 #include "Flonum.h"
44 #include "Bignum.h"
45 #include "ProcedureMacro.h"
46 #include "Compnum.h"
47 #include "TextualOutputPort.h"
48 
49 using namespace scheme;
50 
makePolarEx(VM * theVM,int argc,const Object * argv)51 Object scheme::makePolarEx(VM* theVM, int argc, const Object* argv)
52 {
53     DeclareProcedureName("make-polar");
54     checkArgumentLength(2);
55     argumentCheckNumber(0, n1);
56     argumentCheckNumber(1, n2);
57     return Arithmetic::makePolar(n1, n2);
58 }
59 
exptEx(VM * theVM,int argc,const Object * argv)60 Object scheme::exptEx(VM* theVM, int argc, const Object* argv)
61 {
62     DeclareProcedureName("expt");
63     checkArgumentLength(2);
64     argumentCheckNumber(0, n1);
65     argumentCheckNumber(1, n2);
66     if (n2.isBignum()) {
67         callImplementationRestrictionAfter(theVM, procedureName, "too big", Pair::list2(n1, n2));
68         return Object::Undef;
69     } else {
70         return Arithmetic::expt(n1, n2);
71     }
72 }
73 
sqrtEx(VM * theVM,int argc,const Object * argv)74 Object scheme::sqrtEx(VM* theVM, int argc, const Object* argv)
75 {
76     DeclareProcedureName("sqrt");
77     checkArgumentLength(1);
78     argumentCheckNumber(0, n);
79     return Arithmetic::sqrt(n);
80 }
81 
acosEx(VM * theVM,int argc,const Object * argv)82 Object scheme::acosEx(VM* theVM, int argc, const Object* argv)
83 {
84     DeclareProcedureName("acos");
85     checkArgumentLength(1);
86     argumentCheckNumber(0, n);
87     return Arithmetic::acos(n);
88 }
89 
atanEx(VM * theVM,int argc,const Object * argv)90 Object scheme::atanEx(VM* theVM, int argc, const Object* argv)
91 {
92     DeclareProcedureName("atan");
93     checkArgumentLengthBetween(1, 2);
94     if (argc == 1) {
95         argumentCheckNumber(0, n);
96         bool isDiv0Error = false;
97         const Object ret = Arithmetic::atan(n, isDiv0Error);
98         if (isDiv0Error) {
99             callAssertionViolationAfter(theVM, procedureName, "division by zero", L1(n));
100             return Object::Undef;
101         } else {
102             return ret;
103         }
104     } else {
105         argumentCheckReal(0, n1);
106         argumentCheckReal(0, n2);
107         return Arithmetic::atan2(n1, n2);
108     }
109 }
110 
asinEx(VM * theVM,int argc,const Object * argv)111 Object scheme::asinEx(VM* theVM, int argc, const Object* argv)
112 {
113     DeclareProcedureName("asin");
114     checkArgumentLength(1);
115     argumentCheckNumber(0, n);
116     return Arithmetic::asin(n);
117 }
118 
tanEx(VM * theVM,int argc,const Object * argv)119 Object scheme::tanEx(VM* theVM, int argc, const Object* argv)
120 {
121     DeclareProcedureName("tan");
122     checkArgumentLength(1);
123     argumentCheckNumber(0, n);
124     bool isDiv0Error = false;
125     const Object ret = Arithmetic::tan(n, isDiv0Error);
126     if (isDiv0Error) {
127         callAssertionViolationAfter(theVM, procedureName, "division by zero", L1(n));
128         return Object::Undef;
129     } else {
130         return ret;
131     }
132 }
133 
sinEx(VM * theVM,int argc,const Object * argv)134 Object scheme::sinEx(VM* theVM, int argc, const Object* argv)
135 {
136     DeclareProcedureName("sin");
137     checkArgumentLength(1);
138     const Object ret = Arithmetic::sin(argv[0]);
139     if (ret.isUndef()) {
140         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "nonzero", L1(argv[0]));
141     }
142     return ret;
143 }
144 
cosEx(VM * theVM,int argc,const Object * argv)145 Object scheme::cosEx(VM* theVM, int argc, const Object* argv)
146 {
147     DeclareProcedureName("cos");
148     checkArgumentLength(1);
149     const Object ret = Arithmetic::cos(argv[0]);
150     if (ret.isUndef()) {
151         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "nonzero", L1(argv[0]));
152     }
153     return ret;
154 }
155 
logEx(VM * theVM,int argc,const Object * argv)156 Object scheme::logEx(VM* theVM, int argc, const Object* argv)
157 {
158     DeclareProcedureName("log");
159     checkArgumentLengthBetween(1, 2);
160     if (argc == 1) {
161         argumentCheckNumber(0, n);
162         if (Arithmetic::isExactZero(n)) {
163             callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "nonzero", L1(n));
164             return Object::Undef;
165         }
166         return Arithmetic::log(n);
167     } else {
168         argumentCheckNumber(0, n1);
169 
170         argumentCheckNumber(1, n2);
171         if (Arithmetic::isExactZero(n1) || Arithmetic::isExactZero(n2)) {
172             callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "nonzero", L2(n1, n2));
173             return Object::Undef;
174         }
175         bool isDiv0Error = false;
176         const Object ret = Arithmetic::log(n1, n2, isDiv0Error);
177         if (isDiv0Error) {
178             callAssertionViolationAfter(theVM, procedureName, "division by zero", L2(n1, n2));
179             return Object::Undef;
180         } else {
181             return ret;
182         }
183     }
184 }
185 
expEx(VM * theVM,int argc,const Object * argv)186 Object scheme::expEx(VM* theVM, int argc, const Object* argv)
187 {
188     DeclareProcedureName("exp");
189     checkArgumentLength(1);
190     argumentCheckNumber(0, n);
191     return Arithmetic::exp(n);
192 }
193 
floorEx(VM * theVM,int argc,const Object * argv)194 Object scheme::floorEx(VM* theVM, int argc, const Object* argv)
195 {
196     DeclareProcedureName("floor");
197     checkArgumentLength(1);
198     argumentCheckReal(0, n);
199     return Arithmetic::floor(n);
200 }
201 
ceilingEx(VM * theVM,int argc,const Object * argv)202 Object scheme::ceilingEx(VM* theVM, int argc, const Object* argv)
203 {
204     DeclareProcedureName("ceiling");
205     checkArgumentLength(1);
206     argumentCheckReal(0, n);
207     return Arithmetic::ceiling(n);
208 }
209 
truncateEx(VM * theVM,int argc,const Object * argv)210 Object scheme::truncateEx(VM* theVM, int argc, const Object* argv)
211 {
212     DeclareProcedureName("truncate");
213     checkArgumentLength(1);
214     argumentCheckReal(0, n);
215     return Arithmetic::truncate(n);
216 }
217 
roundEx(VM * theVM,int argc,const Object * argv)218 Object scheme::roundEx(VM* theVM, int argc, const Object* argv)
219 {
220     DeclareProcedureName("round");
221     checkArgumentLength(1);
222     argumentCheckReal(0, n);
223     return Arithmetic::round(n);
224 }
225 
integerDivEx(VM * theVM,int argc,const Object * argv)226 Object scheme::integerDivEx(VM* theVM, int argc, const Object* argv)
227 {
228     DeclareProcedureName("div");
229     checkArgumentLength(2);
230     argumentCheckReal(0, n1);
231     argumentCheckReal(1, n2);
232 
233     if (n1.isFlonum()) {
234         Flonum* const flonum = n1.toFlonum();
235         if (flonum->isInfinite() || flonum->isNan()) {
236             callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "neither infinite nor a NaN", n1);
237             return Object::Undef;
238         }
239     }
240 
241     if (n2.isFixnum()) {
242         const int fn2 = n2.toFixnum();
243         if (0 == fn2) {
244             callAssertionViolationAfter(theVM, procedureName, "div by 0 is not defined", Pair::list2(n1, n2));
245             return Object::Undef;
246         }
247     }
248     if (n2.isFlonum()) {
249         const double fn2 = n2.toFlonum()->value();
250         if (0.0 == fn2) {
251             LOG2("[~a ~a]", n1, n2);
252             callAssertionViolationAfter(theVM, procedureName, "div by 0.0 is not defined", Pair::list2(n1, n2));
253             return Object::Undef;
254         }
255     }
256 
257     if (n1.isFixnum() && n2.isFixnum()) {
258         return Fixnum::integerDiv(n1.toFixnum(), n2.toFixnum());
259     } else if (n1.isFlonum() && n2.isFlonum()) {
260         return Flonum::integerDiv(n1.toFlonum(), n2.toFlonum());
261     } else {
262             bool isDiv0Error = false;
263             Object ret = Object::Undef;
264         if (Arithmetic::isNegative(n2)) {
265             ret = Arithmetic::negate(Arithmetic::floor(Arithmetic::div(n1, Arithmetic::negate(n2), isDiv0Error)));
266         } else {
267             ret = Arithmetic::floor(Arithmetic::div(n1, n2, isDiv0Error));
268         }
269         if (isDiv0Error) {
270             callAssertionViolationAfter(theVM, procedureName, "division by zero", Pair::list2(n1, n2));
271             return Object::Undef;
272         } else {
273             return ret;
274         }
275 
276     }
277 }
278 
integerDiv0Ex(VM * theVM,int argc,const Object * argv)279 Object scheme::integerDiv0Ex(VM* theVM, int argc, const Object* argv)
280 {
281     DeclareProcedureName("div0");
282     checkArgumentLength(2);
283     argumentCheckReal(0, n1);
284     argumentCheckReal(1, n2);
285     Object div = integerDivEx(theVM, argc, argv);
286     if (div.isUndef()) {
287         return Object::Undef;
288     }
289     Object mod = Arithmetic::sub(n1, Arithmetic::mul(div, n2));
290     // we can ignore isDiv0Error parameter of Arithmetic::div.
291     // Because we know division by zero never occur.
292     bool isDiv0Error = false;
293     if (Arithmetic::lt(mod, Arithmetic::abs(Arithmetic::div(n2, Object::makeFixnum(2), isDiv0Error)))) {
294         return div;
295     } else {
296         if (Arithmetic::isNegative(n2)) {
297             return Arithmetic::sub(div, Object::makeFixnum(1));
298         } else {
299             return Arithmetic::add(div, Object::makeFixnum(1));
300         }
301     }
302 }
303 
absEx(VM * theVM,int argc,const Object * argv)304 Object scheme::absEx(VM* theVM, int argc, const Object* argv)
305 {
306     DeclareProcedureName("abs");
307     checkArgumentLength(1);
308     argumentCheckReal(0, n);
309     return Arithmetic::abs(n);
310 }
311 
evenPEx(VM * theVM,int argc,const Object * argv)312 Object scheme::evenPEx(VM* theVM, int argc, const Object* argv)
313 {
314     DeclareProcedureName("even?");
315     checkArgumentLength(1);
316     argumentCheckIntegerValued(0, n);
317     return Object::makeBool(Arithmetic::isEven(n));
318 }
319 
oddPEx(VM * theVM,int argc,const Object * argv)320 Object scheme::oddPEx(VM* theVM, int argc, const Object* argv)
321 {
322     DeclareProcedureName("odd?");
323     checkArgumentLength(1);
324     argumentCheckIntegerValued(0, n);
325     return Object::makeBool(!Arithmetic::isEven(n));
326 }
327 
magnitudeEx(VM * theVM,int argc,const Object * argv)328 Object scheme::magnitudeEx(VM* theVM, int argc, const Object* argv)
329 {
330     DeclareProcedureName("magnitude");
331     checkArgumentLength(1);
332     argumentCheckNumber(0, number);
333     return Arithmetic::magnitude(number);
334 }
335 
angleEx(VM * theVM,int argc,const Object * argv)336 Object scheme::angleEx(VM* theVM, int argc, const Object* argv)
337 {
338     DeclareProcedureName("angle");
339     checkArgumentLength(1);
340     argumentCheckNumber(0, number);
341     return Arithmetic::angle(number);
342 }
343 
complexPEx(VM * theVM,int argc,const Object * argv)344 Object scheme::complexPEx(VM* theVM, int argc, const Object* argv)
345 {
346     DeclareProcedureName("complex?");
347     checkArgumentLength(1);
348     return Object::makeBool(argv[0].isComplex());
349 }
350 
realPEx(VM * theVM,int argc,const Object * argv)351 Object scheme::realPEx(VM* theVM, int argc, const Object* argv)
352 {
353     DeclareProcedureName("real?");
354     checkArgumentLength(1);
355     return Object::makeBool(argv[0].isReal());
356 }
357 
integerPEx(VM * theVM,int argc,const Object * argv)358 Object scheme::integerPEx(VM* theVM, int argc, const Object* argv)
359 {
360     DeclareProcedureName("integer?");
361     checkArgumentLength(1);
362     return Object::makeBool(argv[0].isInteger());
363 }
364 
realValuedPEx(VM * theVM,int argc,const Object * argv)365 Object scheme::realValuedPEx(VM* theVM, int argc, const Object* argv)
366 {
367     DeclareProcedureName("real-valued?");
368     checkArgumentLength(1);
369     const Object n = argv[0];
370     if (n.isNumber()) {
371         return Object::makeBool(Arithmetic::isRealValued(n));
372     } else {
373         return Object::False;
374     }
375 }
376 
rationalValuedPEx(VM * theVM,int argc,const Object * argv)377 Object scheme::rationalValuedPEx(VM* theVM, int argc, const Object* argv)
378 {
379     DeclareProcedureName("rational-valued?");
380     checkArgumentLength(1);
381     const Object n = argv[0];
382     if (n.isNumber()) {
383         return Object::makeBool(Arithmetic::isRationalValued(n));
384     } else {
385         return Object::False;
386     }
387 }
388 
integerValuedPEx(VM * theVM,int argc,const Object * argv)389 Object scheme::integerValuedPEx(VM* theVM, int argc, const Object* argv)
390 {
391     DeclareProcedureName("integer-valued?");
392     checkArgumentLength(1);
393     const Object n = argv[0];
394     if (n.isNumber()) {
395         return Object::makeBool(Arithmetic::isIntegerValued(n));
396     } else {
397         return Object::False;
398     }
399 }
400 
numeratorEx(VM * theVM,int argc,const Object * argv)401 Object scheme::numeratorEx(VM* theVM, int argc, const Object* argv)
402 {
403     DeclareProcedureName("numerator");
404     checkArgumentLength(1);
405     argumentCheckRational(0, rational);
406     return Arithmetic::numerator(rational);
407 }
408 
denominatorEx(VM * theVM,int argc,const Object * argv)409 Object scheme::denominatorEx(VM* theVM, int argc, const Object* argv)
410 {
411     DeclareProcedureName("denominator");
412     checkArgumentLength(1);
413     argumentCheckRational(0, rational);
414     return Arithmetic::denominator(rational);
415 }
416 
infinitePEx(VM * theVM,int argc,const Object * argv)417 Object scheme::infinitePEx(VM* theVM, int argc, const Object* argv)
418 {
419     DeclareProcedureName("infinite?");
420     checkArgumentLength(1);
421     argumentCheckReal(0, real);
422     if (real.isFlonum()) {
423         return Object::makeBool(real.toFlonum()->isInfinite());
424     } else {
425         return Object::False;
426     }
427 }
428 
finitePEx(VM * theVM,int argc,const Object * argv)429 Object scheme::finitePEx(VM* theVM, int argc, const Object* argv)
430 {
431     DeclareProcedureName("finite?");
432     checkArgumentLength(1);
433     argumentCheckReal(0, real);
434     if (real.isFlonum()) {
435         return Object::makeBool(!real.toFlonum()->isInfinite());
436     } else {
437         return Object::True;
438     }
439 }
440 
nanPEx(VM * theVM,int argc,const Object * argv)441 Object scheme::nanPEx(VM* theVM, int argc, const Object* argv)
442 {
443     DeclareProcedureName("nan?");
444     checkArgumentLength(1);
445     argumentCheckReal(0, real);
446     if (real.isFlonum()) {
447         return Object::makeBool(real.toFlonum()->isNan());
448     } else {
449         return Object::False;
450     }
451 }
452 
exactPEx(VM * theVM,int argc,const Object * argv)453 Object scheme::exactPEx(VM* theVM, int argc, const Object* argv)
454 {
455     DeclareProcedureName("exact?");
456     checkArgumentLength(1);
457     argumentCheckNumber(0, number);
458     return Object::makeBool(Arithmetic::isExact(number));
459 }
460 
inexactPEx(VM * theVM,int argc,const Object * argv)461 Object scheme::inexactPEx(VM* theVM, int argc, const Object* argv)
462 {
463     DeclareProcedureName("inexact?");
464     checkArgumentLength(1);
465     argumentCheckNumber(0, number);
466     return Object::makeBool(!Arithmetic::isExact(number));
467 }
468 
realPartEx(VM * theVM,int argc,const Object * argv)469 Object scheme::realPartEx(VM* theVM, int argc, const Object* argv)
470 {
471     DeclareProcedureName("real-part");
472     checkArgumentLength(1);
473     argumentCheckNumber(0, n);
474     return Arithmetic::real(n);
475 }
476 
imagPartEx(VM * theVM,int argc,const Object * argv)477 Object scheme::imagPartEx(VM* theVM, int argc, const Object* argv)
478 {
479     DeclareProcedureName("imag-part");
480     checkArgumentLength(1);
481     argumentCheckNumber(0, n);
482     return Arithmetic::imag(n);
483 }
484 
numberPEx(VM * theVM,int argc,const Object * argv)485 Object scheme::numberPEx(VM* theVM, int argc, const Object* argv)
486 {
487     DeclareProcedureName("number?");
488     checkArgumentLength(1);
489     const Object obj = argv[0];
490     return Object::makeBool(obj.isNumber());
491 }
492 
rationalPEx(VM * theVM,int argc,const Object * argv)493 Object scheme::rationalPEx(VM* theVM, int argc, const Object* argv)
494 {
495     DeclareProcedureName("rational?");
496     checkArgumentLength(1);
497     const Object obj = argv[0];
498     return Object::makeBool(obj.isRational());
499 }
500 
bignumPEx(VM * theVM,int argc,const Object * argv)501 Object scheme::bignumPEx(VM* theVM, int argc, const Object* argv)
502 {
503     DeclareProcedureName("bignum?");
504     checkArgumentLength(1);
505     const Object obj = argv[0];
506     return Object::makeBool(obj.isBignum());
507 }
508 
flonumPEx(VM * theVM,int argc,const Object * argv)509 Object scheme::flonumPEx(VM* theVM, int argc, const Object* argv)
510 {
511     DeclareProcedureName("flonum?");
512     checkArgumentLength(1);
513     return Object::makeBool(argv[0].isFlonum());
514 }
515 
fixnumPEx(VM * theVM,int argc,const Object * argv)516 Object scheme::fixnumPEx(VM* theVM, int argc, const Object* argv)
517 {
518     DeclareProcedureName("fixnum?");
519     checkArgumentLength(1);
520     return Object::makeBool(argv[0].isFixnum());
521 }
522 
makeRectangularEx(VM * theVM,int argc,const Object * argv)523 Object scheme::makeRectangularEx(VM* theVM, int argc, const Object* argv)
524 {
525     DeclareProcedureName("make-rectangular");
526     checkArgumentLength(2);
527     argumentCheckReal(0, real);
528     argumentCheckReal(1, imag);
529     return Object::makeCompnum(real, imag);
530 }
531 
fixnumWidthEx(VM * theVM,int argc,const Object * argv)532 Object scheme::fixnumWidthEx(VM* theVM, int argc, const Object* argv)
533 {
534     DeclareProcedureName("fixnum-width");
535     checkArgumentLength(0);
536     return Object::makeFixnum(Fixnum::BITS);
537 }
538 
leastFixnumEx(VM * theVM,int argc,const Object * argv)539 Object scheme::leastFixnumEx(VM* theVM, int argc, const Object* argv)
540 {
541     DeclareProcedureName("least-fixnum");
542     checkArgumentLength(0);
543     return Object::makeFixnum(Fixnum::MIN);
544 }
545 
greatestFixnumEx(VM * theVM,int argc,const Object * argv)546 Object scheme::greatestFixnumEx(VM* theVM, int argc, const Object* argv)
547 {
548     DeclareProcedureName("greatest-fixnum");
549     checkArgumentLength(0);
550     return Object::makeFixnum(Fixnum::MAX);
551 }
552 
inexactEx(VM * theVM,int argc,const Object * argv)553 Object scheme::inexactEx(VM* theVM, int argc, const Object* argv)
554 {
555     DeclareProcedureName("inexact");
556     checkArgumentLength(1);
557     argumentCheckNumber(0, number);
558     return Arithmetic::inexact(number);
559 }
560 
exactEx(VM * theVM,int argc,const Object * argv)561 Object scheme::exactEx(VM* theVM, int argc, const Object* argv)
562 {
563     DeclareProcedureName("exact");
564     checkArgumentLength(1);
565     argumentCheckNumber(0, number);
566     return Arithmetic::exact(number);
567 }
568 
maxEx(VM * theVM,int argc,const Object * argv)569 Object scheme::maxEx(VM* theVM, int argc, const Object* argv)
570 {
571     DeclareProcedureName("max");
572     checkArgumentLengthAtLeast(1);
573     Object maxNumber = Flonum::NEGATIVE_INF;
574     for (int i = 0; i < argc; i++) {
575         argumentCheckReal(i, number);
576         if (number.isFlonum() && (number.toFlonum())->isNan()) {
577             return number;
578         }
579         if (Arithmetic::gt(number, maxNumber)) {
580             maxNumber = number;
581         }
582     }
583     return maxNumber;
584 }
585 
minEx(VM * theVM,int argc,const Object * argv)586 Object scheme::minEx(VM* theVM, int argc, const Object* argv)
587 {
588     DeclareProcedureName("min");
589     checkArgumentLengthAtLeast(1);
590     Object minNumber = Flonum::POSITIVE_INF;
591     for (int i = 0; i < argc; i++) {
592         argumentCheckReal(i, number);
593         if (number.isFlonum() && (number.toFlonum())->isNan()) {
594             return number;
595         }
596         if (Arithmetic::lt(number, minNumber)) {
597             minNumber = number;
598         }
599     }
600     return minNumber;
601 }
602 
addEx(VM * theVM,int argc,const Object * argv)603 Object scheme::addEx(VM* theVM, int argc, const Object* argv)
604 {
605     DeclareProcedureName("+");
606     if (0 == argc) {
607         return Object::makeFixnum(0);
608     } else if (1 == argc) {
609         argumentCheckNumber(0, number);
610         return number;
611     }
612 
613     Object ret = Object::makeFixnum(0);
614     for (int i = 0; i < argc; i++) {
615         // We don't check whether n is number or not here.
616         ret = Arithmetic::add(ret, argv[i]);
617 
618         // error occured
619         if (ret.isFalse()) {
620             callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(ret, argv[i]));
621             return Object::Undef;
622         }
623     }
624     return ret;
625 }
626 
subEx(VM * theVM,int argc,const Object * argv)627 Object scheme::subEx(VM* theVM, int argc, const Object* argv)
628 {
629     DeclareProcedureName("-");
630     checkArgumentLengthAtLeast(1);
631 
632     if (1 == argc) {
633         argumentCheckNumber(0, number);
634         return Arithmetic::mul(-1, number);
635     }
636 
637     Object ret = argv[0];
638     for (int i = 1; i < argc; i++) {
639         ret = Arithmetic::sub(ret, argv[i]);
640 
641         // error occured
642         if (ret.isFalse()) {
643             callWrongTypeOfArgumentViolationAfter(theVM, "-", "number", L2(ret, argv[i]));
644             return Object::Undef;
645         }
646     }
647     return ret;
648 }
649 
mulEx(VM * theVM,int argc,const Object * argv)650 Object scheme::mulEx(VM* theVM, int argc, const Object* argv)
651 {
652     DeclareProcedureName("*");
653 
654     if (0 == argc) {
655         return Object::makeFixnum(1);
656     } else if (1 == argc) {
657         argumentCheckNumber(0, number);
658         return number;
659     }
660 
661     Object ret = Object::makeFixnum(1);
662     for (int i = 0; i < argc; i++) {
663         ret = Arithmetic::mul(ret, argv[i]);
664 
665         // error occured
666         if (ret.isFalse()) {
667             callWrongTypeOfArgumentViolationAfter(theVM, "*", "number", L2(ret, argv[i]));
668             return Object::Undef;
669         }
670     }
671     return ret;
672 }
673 
divideEx(VM * theVM,int argc,const Object * argv)674 Object scheme::divideEx(VM* theVM, int argc, const Object* argv)
675 {
676     DeclareProcedureName("/");
677     checkArgumentLengthAtLeast(1);
678 
679     bool isDiv0Error = false;
680     if (1 == argc) {
681         argumentCheckNumber(0, number);
682         const Object ret = Arithmetic::div(Object::makeFixnum(1), number, isDiv0Error);
683         if (isDiv0Error) {
684             callAssertionViolationAfter(theVM, procedureName, "division by zero", L2(Object::makeFixnum(1), number));
685             return Object::Undef;
686         } else {
687             return ret;
688         }
689     } else {
690         Object ret = argv[0];
691         for (int i = 1; i < argc; i++) {
692             ret = Arithmetic::div(ret, argv[i], isDiv0Error);
693             if (isDiv0Error) {
694                 callAssertionViolationAfter(theVM, procedureName, "division by zero", L2(ret, argv[i]));
695                 return Object::Undef;
696             } else if (ret.isFalse()) {
697                 callWrongTypeOfArgumentViolationAfter(theVM, "/", "number", L2(ret, argv[i]));
698                 return Object::Undef;
699             }
700         }
701         return ret;
702     }
703 }
704 
eqEx(VM * theVM,int argc,const Object * argv)705 Object scheme::eqEx(VM* theVM, int argc, const Object* argv)
706 {
707     DeclareProcedureName("=");
708     checkArgumentLengthAtLeast(2);
709     for (int i = 0; i < argc - 1; i++) {
710         argumentCheckNumber(i, number1);
711         argumentCheckNumber(i + 1, number2);
712         if (Arithmetic::eq(number1, number2)) {
713             continue;
714         } else {
715             return Object::False;
716         }
717     }
718     return Object::True;
719 }
720 
gtEx(VM * theVM,int argc,const Object * argv)721 Object scheme::gtEx(VM* theVM, int argc, const Object* argv)
722 {
723     DeclareProcedureName(">");
724     checkArgumentLengthAtLeast(2);
725     for (int i = 0; i < argc - 1; i++) {
726         argumentCheckReal(i, number1);
727         argumentCheckReal(i + 1, number2);
728         if (Arithmetic::gt(number1, number2)) {
729             continue;
730         } else {
731             return Object::False;
732         }
733     }
734     return Object::True;
735 }
736 
geEx(VM * theVM,int argc,const Object * argv)737 Object scheme::geEx(VM* theVM, int argc, const Object* argv)
738 {
739     DeclareProcedureName(">=");
740     checkArgumentLengthAtLeast(2);
741     for (int i = 0; i < argc - 1; i++) {
742         argumentCheckReal(i, number1);
743         argumentCheckReal(i + 1, number2);
744         if (Arithmetic::ge(number1, number2)) {
745             continue;
746         } else {
747             return Object::False;
748         }
749     }
750     return Object::True;
751 }
752 
ltEx(VM * theVM,int argc,const Object * argv)753 Object scheme::ltEx(VM* theVM, int argc, const Object* argv)
754 {
755     DeclareProcedureName("<");
756     checkArgumentLengthAtLeast(2);
757     for (int i = 0; i < argc - 1; i++) {
758         argumentCheckReal(i, number1);
759         argumentCheckReal(i + 1, number2);
760         if (Arithmetic::lt(number1, number2)) {
761             continue;
762         } else {
763             return Object::False;
764         }
765     }
766     return Object::True;
767 }
768 
leEx(VM * theVM,int argc,const Object * argv)769 Object scheme::leEx(VM* theVM, int argc, const Object* argv)
770 {
771     DeclareProcedureName("<=");
772     checkArgumentLengthAtLeast(2);
773     for (int i = 0; i < argc - 1; i++) {
774         argumentCheckReal(i, number1);
775         argumentCheckReal(i + 1, number2);
776         if (Arithmetic::le(number1, number2)) {
777             continue;
778         } else {
779             return Object::False;
780         }
781     }
782     return Object::True;
783 }
784 
moduloEx(VM * theVM,int argc,const Object * argv)785 Object scheme::moduloEx(VM* theVM, int argc, const Object* argv)
786 {
787     DeclareProcedureName("modulo");
788     checkArgumentLength(2);
789     const Object x = argv[0];
790     const Object y = argv[1];
791     if (x.isFixnum()) {
792         if (0 == x.toFixnum()) {
793             return Object::makeFixnum(0);
794         } else if (y.isFixnum()) { // fixnum, fixnum
795             if (0 == y.toFixnum()) {
796                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
797                 return Object::Undef;
798             }
799             intptr_t r = x.toFixnum() % y.toFixnum();
800             if (0 == r) {
801                 return Object::makeFixnum(0);
802             }
803             if ((y.toFixnum() > 0) + (r > 0) == 1) {
804                 r = r + y.toFixnum();
805             }
806             return Object::makeFixnum(r);
807         } else if (y.isFlonum()) { // fixnum, flonum
808             const double value = y.toFlonum()->value();
809             if (0.0 == value) {
810                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
811                 return Object::Undef;
812             }
813             double r = fmod(x.toFlonum()->value(), y.toFlonum()->value());
814             if (0.0 == r) {
815                 return Object::makeFlonum(0.0);
816             }
817             if ((y.toFlonum()->value() > 0.0) + (r > 0.0) == 1) {
818                 r = r + y.toFixnum();
819             }
820             Flonum f(r);
821             return f.toExact();
822         } else if (y.isBignum()) { // fixnum, bignum
823             const Object modulo = Bignum::remainder(x.toFixnum(), y.toBignum());
824             if (modulo == Object::makeFixnum(0)) {
825                 return modulo;
826             }
827             const bool a = Arithmetic::isNegative(y);
828             const bool b = Arithmetic::isNegative(modulo);
829             if ((a && !b) || (!a && b)) {
830                 return Arithmetic::add(modulo, y);
831             }
832             return modulo;
833         } else if (y.isCompnum()) {
834             if (y.toCompnum()->isReal()) {
835                 Object arguments[2];
836                 arguments[0] = x;
837                 arguments[1] = y.toCompnum()->real();
838                 return remainderEx(theVM, 2, arguments);
839             }
840         }
841 
842         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
843         return Object::Undef;
844     } else if (x.isFlonum()) {
845         if (y.isFixnum()) { // flonum, fixnum
846             if (0 == y.toFixnum()) {
847                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
848                 return Object::Undef;
849             }
850 
851             double r = fmod(x.toFlonum()->value(), y.toFixnum());
852             if ((y.toFixnum() > 0) + (r > 0.0) == 1) {
853                 r = r + y.toFixnum();
854             }
855             if (r == 0) {
856                 return Object::makeFixnum(0);
857             }
858             Flonum f(r);
859             return f.toExact();
860         } else if (y.isFlonum()) { // flonum, flonum
861             const double value = y.toFlonum()->value();
862             if (0.0 == value) {
863                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
864                 return Object::Undef;
865             }
866             double r = fmod(x.toFlonum()->value(), value);
867             if (0.0 == r) {
868                 return Object::makeFlonum(0.0);
869             }
870             if ((value > 0.0) + (r > 0.0) == 1) {
871                 r = r + y.toFixnum();
872             }
873             Flonum f(r);
874             return f.toExact();
875         } else if (y.isBignum()) { // flonum, bignum
876             const double value = y.toBignum()->toDouble();
877             if (0.0 == value) {
878                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
879                 return Object::Undef;
880             }
881             double r = fmod(x.toFlonum()->value(), value);
882             if (0.0 == r) {
883                 return Object::makeFlonum(0.0);
884             }
885             if ((value > 0.0) + (r > 0.0) == 1) {
886                 r = r + y.toFixnum();
887             }
888             Flonum f(r);
889             return f.toExact();
890         } else if (y.isCompnum()) { // flonum, compnum
891             if (y.toCompnum()->isReal()) {
892                 Object arguments[2];
893                 arguments[0] = x;
894                 arguments[1] = y.toCompnum()->real();
895                 return moduloEx(theVM, 2, arguments);
896             }
897         }
898 
899         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
900         return Object::Undef;
901     } else if (x.isBignum()) {
902         if (y.isFixnum()) { // bignum, fixnum
903             if (0 == y.toFixnum()) {
904                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
905                 return Object::Undef;
906             }
907 
908             const Object modulo = Bignum::remainder(x.toBignum(), y.toFixnum());
909             if (modulo == Object::makeFixnum(0)) {
910                 return modulo;
911             }
912             const bool a = Arithmetic::isNegative(y);
913             const bool b = Arithmetic::isNegative(modulo);
914             if ((a && !b) || (!a && b)) {
915                 return Arithmetic::add(modulo, y);
916             }
917             return modulo;
918         } else if (y.isFlonum()) { // bignum, flonum
919             const double value = y.toFlonum()->value();
920             if (0.0 == value) {
921                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
922                 return Object::Undef;
923             }
924             double r = fmod(x.toBignum()->toDouble(), value);
925             if (0.0 == r) {
926                 return Object::makeFlonum(0.0);
927             }
928             if ((value > 0.0) + (r > 0.0) == 1) {
929                 r = r + y.toFixnum();
930             }
931             Flonum f(r);
932             return f.toExact();
933         } else if (y.isBignum()) {
934             const Object modulo = Bignum::remainder(x.toBignum(), y.toBignum());
935             if (modulo == Object::makeFixnum(0)) {
936                 return modulo;
937             }
938             const bool a = Arithmetic::isNegative(y);
939             const bool b = Arithmetic::isNegative(modulo);
940             if ((a && !b) || (!a && b)) {
941                 return Arithmetic::add(modulo, y);
942             }
943             return modulo;
944         } else if (y.isCompnum()) { // bignum, compnum
945             if (y.toCompnum()->isReal()) {
946                 Object arguments[2];
947                 arguments[0] = x;
948                 arguments[1] = y.toCompnum()->real();
949                 return moduloEx(theVM, 2, arguments);
950             }
951         }
952         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
953         return Object::Undef;
954     } else if (x.isCompnum()) {
955         if (x.toCompnum()->isReal()) {
956                 Object arguments[2];
957                 arguments[0] = x.toCompnum()->real();
958                 arguments[1] = y;
959                 return moduloEx(theVM, 2, arguments);
960         }
961     }
962     callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
963     return Object::Undef;
964 }
965 
966 // For faster execution, we write all the code for quotient here.
quotientEx(VM * theVM,int argc,const Object * argv)967 Object scheme::quotientEx(VM* theVM, int argc, const Object* argv)
968 {
969     DeclareProcedureName("quotient");
970     checkArgumentLength(2);
971     const Object x = argv[0];
972     const Object y = argv[1];
973     if (x.isFixnum()) {
974         if (0 == x.toFixnum()) {
975             return Object::makeFixnum(0);
976         } else if (y.isFixnum()) { // fixnum, fixnum
977             if (0 == y.toFixnum()) {
978                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
979                 return Object::Undef;
980             }
981             return Object::makeFixnum(x.toFixnum() / y.toFixnum());
982         } else if (y.isFlonum()) { // fixnum, flonum
983             const double value = y.toFlonum()->value();
984             if (0.0 == value) {
985                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
986                 return Object::Undef;
987             }
988             Flonum f(x.toFixnum() / value);
989             return f.toExact();
990         } else if (y.isBignum()) { // fixnum, bignum
991             if (Arithmetic::eq(y, Object::makeFixnum(0))) {
992                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
993                 return Object::Undef;
994             }
995             return Bignum::quotient(x.toFixnum(), y.toBignum());
996         } else if (y.isCompnum()) {
997             if (y.toCompnum()->isReal()) {
998                 Object arguments[2];
999                 arguments[0] = x;
1000                 arguments[1] = y.toCompnum()->real();
1001                 return quotientEx(theVM, 2, arguments);
1002             }
1003         }
1004 
1005         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1006         return Object::Undef;
1007     } else if (x.isFlonum()) {
1008         if (y.isFixnum()) { // flonum, fixnum
1009             if (0 == y.toFixnum()) {
1010                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1011                 return Object::Undef;
1012             }
1013             Flonum f(::trunc(x.toFlonum()->value() / y.toFixnum()));
1014             return f.toExact();
1015         } else if (y.isFlonum()) { // flonum, flonum
1016             const double value = y.toFlonum()->value();
1017             if (0.0 == value) {
1018                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1019                 return Object::Undef;
1020             }
1021             Flonum f(::trunc(x.toFlonum()->value() / value));
1022             return f.toExact();
1023         } else if (y.isBignum()) { // flonum, bignum
1024             Flonum f(::trunc(x.toFlonum()->value() / y.toBignum()->toDouble()));
1025             return f.toExact();
1026         } else if (y.isCompnum()) { // flonum, compnum
1027             if (y.toCompnum()->isReal()) {
1028                 Object arguments[2];
1029                 arguments[0] = x;
1030                 arguments[1] = y.toCompnum()->real();
1031                 return quotientEx(theVM, 2, arguments);
1032             }
1033         }
1034 
1035         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1036         return Object::Undef;
1037     } else if (x.isBignum()) {
1038         if (y.isFixnum()) { // bignum, fixnum
1039             if (0 == y.toFixnum()) {
1040                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1041                 return Object::Undef;
1042             }
1043             return Bignum::quotient(x.toBignum(), y.toFixnum());
1044         } else if (y.isFlonum()) { // bignum, flonum
1045             const double value = y.toFlonum()->value();
1046             if (0.0 == value) {
1047                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1048                 return Object::Undef;
1049             }
1050             Flonum f(::trunc(y.toBignum()->toDouble() / x.toFlonum()->value()));
1051             return f.toExact();
1052         } else if (y.isBignum()) {
1053             return Bignum::quotient(x.toBignum(), y.toBignum());
1054         } else if (y.isCompnum()) { // bignum, compnum
1055             if (y.toCompnum()->isReal()) {
1056                 Object arguments[2];
1057                 arguments[0] = x;
1058                 arguments[1] = y.toCompnum()->real();
1059                 return quotientEx(theVM, 2, arguments);
1060             }
1061         }
1062         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1063         return Object::Undef;
1064     } else if (x.isCompnum()) {
1065         if (x.toCompnum()->isReal()) {
1066                 Object arguments[2];
1067                 arguments[0] = x.toCompnum()->real();
1068                 arguments[1] = y;
1069                 return quotientEx(theVM, 2, arguments);
1070         }
1071     }
1072     callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1073     return Object::Undef;
1074 }
1075 
remainderEx(VM * theVM,int argc,const Object * argv)1076 Object scheme::remainderEx(VM* theVM, int argc, const Object* argv)
1077 {
1078     DeclareProcedureName("remainder");
1079     checkArgumentLength(2);
1080     const Object x = argv[0];
1081     const Object y = argv[1];
1082     if (x.isFixnum()) {
1083         if (0 == x.toFixnum()) {
1084             return Object::makeFixnum(0);
1085         } else if (y.isFixnum()) { // fixnum, fixnum
1086             if (0 == y.toFixnum()) {
1087                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1088                 return Object::Undef;
1089             }
1090             return Object::makeFixnum(x.toFixnum() % y.toFixnum());
1091         } else if (y.isFlonum()) { // fixnum, flonum
1092             const double value = y.toFlonum()->value();
1093             if (0.0 == value) {
1094                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1095                 return Object::Undef;
1096             }
1097             Flonum f(fmod(x.toFixnum(), value));
1098             return f.toExact();
1099         } else if (y.isBignum()) { // fixnum, bignum
1100             if (Arithmetic::eq(y, Object::makeFixnum(0))) {
1101                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1102                 return Object::Undef;
1103             }
1104             return Bignum::remainder(x.toFixnum(), y.toBignum());
1105         } else if (y.isCompnum()) {
1106             if (y.toCompnum()->isReal()) {
1107                 Object arguments[2];
1108                 arguments[0] = x;
1109                 arguments[1] = y.toCompnum()->real();
1110                 return remainderEx(theVM, 2, arguments);
1111             }
1112         }
1113 
1114         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1115         return Object::Undef;
1116     } else if (x.isFlonum()) {
1117         if (y.isFixnum()) { // flonum, fixnum
1118             if (0 == y.toFixnum()) {
1119                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1120                 return Object::Undef;
1121             }
1122             Flonum f(::fmod(x.toFlonum()->value(),y.toFixnum()));
1123             return f.toExact();
1124         } else if (y.isFlonum()) { // flonum, flonum
1125             const double value = y.toFlonum()->value();
1126             if (0.0 == value) {
1127                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1128                 return Object::Undef;
1129             }
1130             Flonum f(::fmod(x.toFlonum()->value(), value));
1131             return f.toExact();
1132         } else if (y.isBignum()) { // flonum, bignum
1133             Flonum f(::fmod(x.toFlonum()->value(), y.toBignum()->toDouble()));
1134             return f.toExact();
1135         } else if (y.isCompnum()) { // flonum, compnum
1136             if (y.toCompnum()->isReal()) {
1137                 Object arguments[2];
1138                 arguments[0] = x;
1139                 arguments[1] = y.toCompnum()->real();
1140                 return remainderEx(theVM, 2, arguments);
1141             }
1142         }
1143 
1144         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1145         return Object::Undef;
1146     } else if (x.isBignum()) {
1147         if (y.isFixnum()) { // bignum, fixnum
1148             if (0 == y.toFixnum()) {
1149                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1150                 return Object::Undef;
1151             }
1152             return Bignum::remainder(x.toBignum(), y.toFixnum());
1153         } else if (y.isFlonum()) { // bignum, flonum
1154             const double value = y.toFlonum()->value();
1155             if (0.0 == value) {
1156                 callAssertionViolationAfter(theVM, procedureName, "must be non-zero", L2(x, y));
1157                 return Object::Undef;
1158             }
1159             Flonum f(::fmod(y.toBignum()->toDouble(), x.toFlonum()->value()));
1160             return f.toExact();
1161         } else if (y.isBignum()) {
1162             return Bignum::remainder(x.toBignum(), y.toBignum());
1163         } else if (y.isCompnum()) { // bignum, compnum
1164             if (y.toCompnum()->isReal()) {
1165                 Object arguments[2];
1166                 arguments[0] = x;
1167                 arguments[1] = y.toCompnum()->real();
1168                 return remainderEx(theVM, 2, arguments);
1169             }
1170         }
1171         callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1172         return Object::Undef;
1173     } else if (x.isCompnum()) {
1174         if (x.toCompnum()->isReal()) {
1175                 Object arguments[2];
1176                 arguments[0] = x.toCompnum()->real();
1177                 arguments[1] = y;
1178                 return remainderEx(theVM, 2, arguments);
1179         }
1180     }
1181     callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "number", L2(x, y));
1182     return Object::Undef;
1183 }
1184