comparison src/fns.c @ 1983:9c872f33ecbe

[xemacs-hg @ 2004-04-05 22:49:31 by james] Add bignum, ratio, and bigfloat support.
author james
date Mon, 05 Apr 2004 22:50:11 +0000
parents c66036f59678
children fd0cbe945410
comparison
equal deleted inserted replaced
1982:a748951fd4fb 1983:9c872f33ecbe
147 return arg; 147 return arg;
148 } 148 }
149 149
150 DEFUN ("random", Frandom, 0, 1, 0, /* 150 DEFUN ("random", Frandom, 0, 1, 0, /*
151 Return a pseudo-random number. 151 Return a pseudo-random number.
152 All integers representable in Lisp are equally likely. 152 All fixnums are equally likely. On most systems, this is 31 bits' worth.
153 On most systems, this is 28 bits' worth.
154 With positive integer argument N, return random number in interval [0,N). 153 With positive integer argument N, return random number in interval [0,N).
154 N can be a bignum, in which case the range of possible values is extended.
155 With argument t, set the random number seed from the current time and pid. 155 With argument t, set the random number seed from the current time and pid.
156 */ 156 */
157 (limit)) 157 (limit))
158 { 158 {
159 EMACS_INT val; 159 EMACS_INT val;
173 denominator = ((unsigned long)1 << VALBITS) / XINT (limit); 173 denominator = ((unsigned long)1 << VALBITS) / XINT (limit);
174 do 174 do
175 val = get_random () / denominator; 175 val = get_random () / denominator;
176 while (val >= XINT (limit)); 176 while (val >= XINT (limit));
177 } 177 }
178 #ifdef HAVE_BIGNUM
179 else if (BIGNUMP (limit))
180 {
181 bignum_random (scratch_bignum, XBIGNUM_DATA (limit));
182 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
183 }
184 #endif
178 else 185 else
179 val = get_random (); 186 val = get_random ();
180 187
181 return make_int (val); 188 return make_int (val);
182 } 189 }
2838 if (depth > 200) 2845 if (depth > 200)
2839 stack_overflow ("Stack overflow in equalp", Qunbound); 2846 stack_overflow ("Stack overflow in equalp", Qunbound);
2840 QUIT; 2847 QUIT;
2841 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) 2848 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
2842 return 1; 2849 return 1;
2850 #ifdef WITH_NUMBER_TYPES
2851 if (NUMBERP (obj1) && NUMBERP (obj2))
2852 {
2853 switch (promote_args (&obj1, &obj2))
2854 {
2855 case FIXNUM_T:
2856 return XREALINT (obj1) == XREALINT (obj2);
2857 #ifdef HAVE_BIGNUM
2858 case BIGNUM_T:
2859 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
2860 #endif
2861 #ifdef HAVE_RATIO
2862 case RATIO_T:
2863 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
2864 #endif
2865 case FLOAT_T:
2866 return XFLOAT_DATA (obj1) == XFLOAT_DATA (obj2);
2867 #ifdef HAVE_BIGFLOAT
2868 case BIGFLOAT_T:
2869 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
2870 #endif
2871 }
2872 }
2873 #else
2843 if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2))) 2874 if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2)))
2844 return extract_float (obj1) == extract_float (obj2); 2875 return extract_float (obj1) == extract_float (obj2);
2876 #endif
2845 if (CHARP (obj1) && CHARP (obj2)) 2877 if (CHARP (obj1) && CHARP (obj2))
2846 return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2)); 2878 return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2));
2847 if (XTYPE (obj1) != XTYPE (obj2)) 2879 if (XTYPE (obj1) != XTYPE (obj2))
2848 return 0; 2880 return 0;
2849 if (LRECORDP (obj1)) 2881 if (LRECORDP (obj1))