Mercurial > hg > xemacs-beta

comparison src/data.c @ 280:7df0dd720c89 r21-0b38

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b38
author cvs
date Mon, 13 Aug 2007 10:32:22 +0200
parents 6330739388db
children 972bbb6d6ca2
comparison
equal deleted inserted replaced
279:c20b2fb5bb0a 280:7df0dd720c89
185 185
186 Special kludge: A character is considered `old-eq' to its equivalent integer 186 Special kludge: A character is considered `old-eq' to its equivalent integer
187 even though they are not the same object and are in fact of different 187 even though they are not the same object and are in fact of different
188 types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to 188 types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
189 preserve byte-code compatibility with v19. This kludge is known as the 189 preserve byte-code compatibility with v19. This kludge is known as the
190 \"char-to-int confoundance disease\" and appears in a number of other 190 \"char-int confoundance disease\" and appears in a number of other
191 functions with `old-foo' equivalents. 191 functions with `old-foo' equivalents.
192 192
193 Do not use this function! 193 Do not use this function!
194 */ 194 */
195 (obj1, obj2)) 195 (obj1, obj2))
372 } 372 }
373 373
374 374
375 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /* 375 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /*
376 Return t if OBJECT is a character. 376 Return t if OBJECT is a character.
377 Unlike in XEmacs v19 and Emacs, a character is its own primitive type. 377 Unlike in XEmacs v19 and FSF Emacs, a character is its own primitive type.
378 Any character can be converted into an equivalent integer using 378 Any character can be converted into an equivalent integer using
379 `char-to-int'. To convert the other way, use `int-to-char'; however, 379 `char-int'. To convert the other way, use `int-char'; however,
380 only some integers can be converted into characters. Such an integer 380 only some integers can be converted into characters. Such an integer
381 is called a `char-int'; see `char-int-p'. 381 is called a `char-int'; see `char-int-p'.
382 382
383 Some functions that work on integers (e.g. the comparison functions 383 Some functions that work on integers (e.g. the comparison functions
384 <, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.) 384 <, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.)
432 return Qnil; 432 return Qnil;
433 } 433 }
434 434
435 DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /* 435 DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /*
436 Return t if OBJECT is an integer that can be converted into a character. 436 Return t if OBJECT is an integer that can be converted into a character.
437 See `char-to-int'. 437 See `char-int'.
438 */ 438 */
439 (object)) 439 (object))
440 { 440 {
441 return CHAR_INTP (object) ? Qt : Qnil; 441 return CHAR_INTP (object) ? Qt : Qnil;
442 } 442 }
972 972
973 /**********************************************************************/ 973 /**********************************************************************/
974 /* Arithmetic functions */ 974 /* Arithmetic functions */
975 /**********************************************************************/ 975 /**********************************************************************/
976 976
977 enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal }; 977 Lisp_Object
978 978 arithcompare (Lisp_Object num1, Lisp_Object num2,
979 static Lisp_Object 979 enum arith_comparison comparison)
980 arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
981 { 980 {
982 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num1); 981 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num1);
983 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num2); 982 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num2);
984 983
985 #ifdef LISP_FLOAT_TYPE 984 #ifdef LISP_FLOAT_TYPE
988 double f1 = FLOATP (num1) ? float_data (XFLOAT (num1)) : XINT (num1); 987 double f1 = FLOATP (num1) ? float_data (XFLOAT (num1)) : XINT (num1);
989 double f2 = FLOATP (num2) ? float_data (XFLOAT (num2)) : XINT (num2); 988 double f2 = FLOATP (num2) ? float_data (XFLOAT (num2)) : XINT (num2);
990 989
991 switch (comparison) 990 switch (comparison)
992 { 991 {
993 case equal: return f1 == f2 ? Qt : Qnil; 992 case arith_equal: return f1 == f2 ? Qt : Qnil;
994 case notequal: return f1 != f2 ? Qt : Qnil; 993 case arith_notequal: return f1 != f2 ? Qt : Qnil;
995 case less: return f1 < f2 ? Qt : Qnil; 994 case arith_less: return f1 < f2 ? Qt : Qnil;
996 case less_or_equal: return f1 <= f2 ? Qt : Qnil; 995 case arith_less_or_equal: return f1 <= f2 ? Qt : Qnil;
997 case grtr: return f1 > f2 ? Qt : Qnil; 996 case arith_grtr: return f1 > f2 ? Qt : Qnil;
998 case grtr_or_equal: return f1 >= f2 ? Qt : Qnil; 997 case arith_grtr_or_equal: return f1 >= f2 ? Qt : Qnil;
999 } 998 }
1000 } 999 }
1001 #endif /* LISP_FLOAT_TYPE */ 1000 #endif /* LISP_FLOAT_TYPE */
1002 1001
1003 switch (comparison) 1002 switch (comparison)
1004 { 1003 {
1005 case equal: return XINT (num1) == XINT (num2) ? Qt : Qnil; 1004 case arith_equal: return XINT (num1) == XINT (num2) ? Qt : Qnil;
1006 case notequal: return XINT (num1) != XINT (num2) ? Qt : Qnil; 1005 case arith_notequal: return XINT (num1) != XINT (num2) ? Qt : Qnil;
1007 case less: return XINT (num1) < XINT (num2) ? Qt : Qnil; 1006 case arith_less: return XINT (num1) < XINT (num2) ? Qt : Qnil;
1008 case less_or_equal: return XINT (num1) <= XINT (num2) ? Qt : Qnil; 1007 case arith_less_or_equal: return XINT (num1) <= XINT (num2) ? Qt : Qnil;
1009 case grtr: return XINT (num1) > XINT (num2) ? Qt : Qnil; 1008 case arith_grtr: return XINT (num1) > XINT (num2) ? Qt : Qnil;
1010 case grtr_or_equal: return XINT (num1) >= XINT (num2) ? Qt : Qnil; 1009 case arith_grtr_or_equal: return XINT (num1) >= XINT (num2) ? Qt : Qnil;
1011 } 1010 }
1012 1011
1013 abort (); 1012 abort ();
1014 return Qnil; /* suppress compiler warning */ 1013 return Qnil; /* suppress compiler warning */
1015 } 1014 }
1016 1015
1017 DEFUN ("=", Feqlsign, 2, 2, 0, /*
1018 Return t if two args, both numbers, characters or markers, are equal.
1019 */
1020 (num1, num2))
1021 {
1022 return arithcompare (num1, num2, equal);
1023 }
1024
1025 DEFUN ("<", Flss, 2, 2, 0, /*
1026 Return t if first arg is less than second arg.
1027 Both must be numbers, characters or markers.
1028 */
1029 (num1, num2))
1030 {
1031 return arithcompare (num1, num2, less);
1032 }
1033
1034 DEFUN (">", Fgtr, 2, 2, 0, /*
1035 Return t if first arg is greater than second arg.
1036 Both must be numbers, characters or markers.
1037 */
1038 (num1, num2))
1039 {
1040 return arithcompare (num1, num2, grtr);
1041 }
1042
1043 DEFUN ("<=", Fleq, 2, 2, 0, /*
1044 Return t if first arg is less than or equal to second arg.
1045 Both must be numbers, characters or markers.
1046 */
1047 (num1, num2))
1048 {
1049 return arithcompare (num1, num2, less_or_equal);
1050 }
1051
1052 DEFUN (">=", Fgeq, 2, 2, 0, /*
1053 Return t if first arg is greater than or equal to second arg.
1054 Both must be numbers, characters or markers.
1055 */
1056 (num1, num2))
1057 {
1058 return arithcompare (num1, num2, grtr_or_equal);
1059 }
1060
1061 DEFUN ("/=", Fneq, 2, 2, 0, /*
1062 Return t if first arg is not equal to second arg.
1063 Both must be numbers, characters or markers.
1064 */
1065 (num1, num2))
1066 {
1067 return arithcompare (num1, num2, notequal);
1068 }
1069
1070 #if 0
1071 /* I tried implementing Common Lisp multi-arg comparison functions,
1072 but failed because the byte-compiler needs to be hacked as well. */
1073
1074 static Lisp_Object 1016 static Lisp_Object
1075 arithcompare_many (enum comparison comparison, int nargs, Lisp_Object *args) 1017 arithcompare_many (enum arith_comparison comparison,
1076 { 1018 int nargs, Lisp_Object *args)
1077 REGISTER int argnum; 1019 {
1078 for (argnum = 1; argnum < nargs; argnum++) 1020 for (; --nargs > 0; args++)
1079 if (EQ (arithcompare ( args[argnum-1], args[argnum], comparison), Qnil)) 1021 if (NILP (arithcompare (*args, *(args + 1), comparison)))
1080 return Qnil; 1022 return Qnil;
1081 1023
1082 return Qt; 1024 return Qt;
1083 } 1025 }
1084 1026
1085 xxxDEFUN ("=", Feqlsign, 1, MANY, 0, /* 1027 DEFUN ("=", Feqlsign, 1, MANY, 0, /*
1086 Return t if all the arguments are equal. 1028 Return t if all the arguments are numerically equal.
1087 The arguments may be numbers, characters or markers. 1029 The arguments may be numbers, characters or markers.
1088 */ 1030 */
1089 (int nargs, Lisp_Object *args)) 1031 (int nargs, Lisp_Object *args))
1090 { 1032 {
1091 return arithcompare (equal, nargs, args); 1033 return arithcompare_many (arith_equal, nargs, args);
1092 } 1034 }
1093 1035
1094 xxxDEFUN ("<", Flss, 1, MANY, 0, /* 1036 DEFUN ("<", Flss, 1, MANY, 0, /*
1095 Return t if the sequence of arguments is monotonically increasing. 1037 Return t if the sequence of arguments is monotonically increasing.
1096 The arguments may be numbers, characters or markers. 1038 The arguments may be numbers, characters or markers.
1097 */ 1039 */
1098 (int nargs, Lisp_Object *args)) 1040 (int nargs, Lisp_Object *args))
1099 { 1041 {
1100 return arithcompare (less, nargs, args); 1042 return arithcompare_many (arith_less, nargs, args);
1101 } 1043 }
1102 1044
1103 xxxDEFUN (">", Fgtr, 1, MANY, 0, /* 1045 DEFUN (">", Fgtr, 1, MANY, 0, /*
1104 Return t if the sequence of arguments is monotonically decreasing. 1046 Return t if the sequence of arguments is monotonically decreasing.
1105 The arguments may be numbers, characters or markers. 1047 The arguments may be numbers, characters or markers.
1106 */ 1048 */
1107 (int nargs, Lisp_Object *args)) 1049 (int nargs, Lisp_Object *args))
1108 { 1050 {
1109 return arithcompare (grtr, nargs, args); 1051 return arithcompare_many (arith_grtr, nargs, args);
1110 } 1052 }
1111 1053
1112 xxxDEFUN ("<=", Fleq, 1, MANY, 0, /* 1054 DEFUN ("<=", Fleq, 1, MANY, 0, /*
1113 Return t if the sequence of arguments is monotonically nondecreasing. 1055 Return t if the sequence of arguments is monotonically nondecreasing.
1114 The arguments may be numbers, characters or markers. 1056 The arguments may be numbers, characters or markers.
1115 */ 1057 */
1116 (int nargs, Lisp_Object *args)) 1058 (int nargs, Lisp_Object *args))
1117 { 1059 {
1118 return arithcompare (less_or_equal, nargs, args); 1060 return arithcompare_many (arith_less_or_equal, nargs, args);
1119 } 1061 }
1120 1062
1121 xxxDEFUN (">=", Fgeq, 1, MANY, 0, /* 1063 DEFUN (">=", Fgeq, 1, MANY, 0, /*
1122 Return t if the sequence of arguments is monotonically nonincreasing. 1064 Return t if the sequence of arguments is monotonically nonincreasing.
1123 The arguments may be numbers, characters or markers. 1065 The arguments may be numbers, characters or markers.
1124 */ 1066 */
1125 (int nargs, Lisp_Object *args)) 1067 (int nargs, Lisp_Object *args))
1126 { 1068 {
1127 return arithcompare_many (grtr_or_equal, nargs, args); 1069 return arithcompare_many (arith_grtr_or_equal, nargs, args);
1128 } 1070 }
1129 1071
1130 xxxDEFUN ("/=", Fneq, 1, MANY, 0, /* 1072 DEFUN ("/=", Fneq, 1, MANY, 0, /*
1131 Return t if the sequence of arguments is monotonically increasing. 1073 Return t if no two arguments are numerically equal.
1132 The arguments may be numbers, characters or markers. 1074 The arguments may be numbers, characters or markers.
1133 */ 1075 */
1134 (int nargs, Lisp_Object *args)) 1076 (int nargs, Lisp_Object *args))
1135 { 1077 {
1136 return arithcompare_many (notequal, nargs, args); 1078 return arithcompare_many (arith_notequal, nargs, args);
1137 } 1079 }
1138 #endif /* 0 - disabled for now */
1139 1080
1140 DEFUN ("zerop", Fzerop, 1, 1, 0, /* 1081 DEFUN ("zerop", Fzerop, 1, 1, 0, /*
1141 Return t if NUMBER is zero. 1082 Return t if NUMBER is zero.
1142 */ 1083 */
1143 (number)) 1084 (number))