ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/microscheme/scheme.c
(Generate patch)

Comparing microscheme/scheme.c (file contents):
Revision 1.24 by root, Fri Nov 27 02:12:08 2015 UTC vs.
Revision 1.25 by root, Fri Nov 27 04:37:26 2015 UTC

… …
219#if USE_MATH 219#if USE_MATH
220static double round_per_R5RS (double x); 220static double round_per_R5RS (double x);
221#endif 221#endif
222static int is_zero_rvalue (RVALUE x); 222static int is_zero_rvalue (RVALUE x);
223 223
224ecb_inline int
225num_is_integer (pointer p)
226{
227 return num_is_fixnum (p->object.number);
228}
229
230static num num_zero; 224static num num_zero;
231static num num_one; 225static num num_one;
232 226
233/* macros for cell operations */ 227/* macros for cell operations */
234#define typeflag(p) ((p)->flag + 0) 228#define typeflag(p) ((p)->flag + 0)
… …
272} 266}
273 267
274INTERFACE int 268INTERFACE int
275is_integer (pointer p) 269is_integer (pointer p)
276{ 270{
277 if (!is_number (p)) 271 return is_number (p) && num_is_fixnum (p->object.number);
278 return 0;
279
280 if (num_is_integer (p) || ivalue (p) == rvalue (p))
281 return 1;
282
283 return 0;
284} 272}
285 273
286INTERFACE int 274INTERFACE int
287is_real (pointer p) 275is_real (pointer p)
288{ 276{
… …
2480 { 2468 {
2481 p = SCHEME_V->strbuff; 2469 p = SCHEME_V->strbuff;
2482 2470
2483 if (f <= 1 || f == 10) /* f is the base for numbers if > 1 */ 2471 if (f <= 1 || f == 10) /* f is the base for numbers if > 1 */
2484 { 2472 {
2485 if (num_is_integer (l)) 2473 if (is_integer (l))
2486 xnum (p, ivalue_unchecked (l)); 2474 xnum (p, ivalue_unchecked (l));
2487#if USE_REAL 2475#if USE_REAL
2488 else 2476 else
2489 { 2477 {
2490 snprintf (p, STRBUFFSIZE, "%.10g", rvalue_unchecked (l)); 2478 snprintf (p, STRBUFFSIZE, "%.10g", rvalue_unchecked (l));
… …
2745 return 0; 2733 return 0;
2746 } 2734 }
2747 else if (is_number (a)) 2735 else if (is_number (a))
2748 { 2736 {
2749 if (is_number (b)) 2737 if (is_number (b))
2750 if (num_is_integer (a) == num_is_integer (b))
2751 return num_cmp (nvalue (a), nvalue (b)) == 0; 2738 return num_cmp (nvalue (a), nvalue (b)) == 0;
2752 2739
2753 return 0; 2740 return 0;
2754 } 2741 }
2755 else if (is_character (a)) 2742 else if (is_character (a))
2756 { 2743 {
… …
3930 3917
3931 switch (op) 3918 switch (op)
3932 { 3919 {
3933#if USE_MATH 3920#if USE_MATH
3934 case OP_INEX2EX: /* inexact->exact */ 3921 case OP_INEX2EX: /* inexact->exact */
3935 if (num_is_integer (x)) 3922 if (is_integer (x))
3936 s_return (x); 3923 s_return (x);
3937 else if (modf (rvalue_unchecked (x), &dd) == 0) 3924 else if (modf (rvalue_unchecked (x), &dd) == 0)
3938 s_return (mk_integer (SCHEME_A_ ivalue (x))); 3925 s_return (mk_integer (SCHEME_A_ ivalue (x)));
3939 else 3926 else
3940 Error_1 ("inexact->exact: not integral:", x); 3927 Error_1 ("inexact->exact: not integral:", x);
… …
3963 { 3950 {
3964 RVALUE result; 3951 RVALUE result;
3965 int real_result = 1; 3952 int real_result = 1;
3966 pointer y = cadr (args); 3953 pointer y = cadr (args);
3967 3954
3968 if (num_is_integer (x) && num_is_integer (y)) 3955 if (is_integer (x) && is_integer (y))
3969 real_result = 0; 3956 real_result = 0;
3970 3957
3971 /* This 'if' is an R5RS compatibility fix. */ 3958 /* This 'if' is an R5RS compatibility fix. */
3972 /* NOTE: Remove this 'if' fix for R6RS. */ 3959 /* NOTE: Remove this 'if' fix for R6RS. */
3973 if (rvalue (x) == 0 && rvalue (y) < 0) 3960 if (rvalue (x) == 0 && rvalue (y) < 0)

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines