Mercurial > hg > xemacs-beta
comparison src/fns.c @ 424:11054d720c21 r21-2-20
Import from CVS: tag r21-2-20
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:26:11 +0200 |
parents | 41dbb7a9d5f2 |
children |
comparison
equal
deleted
inserted
replaced
423:28d9c139be4c | 424:11054d720c21 |
---|---|
59 Lisp_Object Qidentity; | 59 Lisp_Object Qidentity; |
60 | 60 |
61 static int internal_old_equal (Lisp_Object, Lisp_Object, int); | 61 static int internal_old_equal (Lisp_Object, Lisp_Object, int); |
62 | 62 |
63 static Lisp_Object | 63 static Lisp_Object |
64 mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) | 64 mark_bit_vector (Lisp_Object obj) |
65 { | 65 { |
66 return Qnil; | 66 return Qnil; |
67 } | 67 } |
68 | 68 |
69 static void | 69 static void |
70 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 70 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
71 { | 71 { |
72 int i; | 72 size_t i; |
73 struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); | 73 struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); |
74 int len = bit_vector_length (v); | 74 size_t len = bit_vector_length (v); |
75 int last = len; | 75 size_t last = len; |
76 | 76 |
77 if (INTP (Vprint_length)) | 77 if (INTP (Vprint_length)) |
78 last = min (len, XINT (Vprint_length)); | 78 last = min (len, XINT (Vprint_length)); |
79 write_c_string ("#*", printcharfun); | 79 write_c_string ("#*", printcharfun); |
80 for (i = 0; i < last; i++) | 80 for (i = 0; i < last; i++) |
109 memory_hash (v->bits, | 109 memory_hash (v->bits, |
110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * | 110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * |
111 sizeof (long))); | 111 sizeof (long))); |
112 } | 112 } |
113 | 113 |
114 static const struct lrecord_description bit_vector_description[] = { | |
115 { XD_LISP_OBJECT, offsetof(Lisp_Bit_Vector, next), 1 }, | |
116 { XD_END } | |
117 }; | |
118 | |
119 | |
114 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, | 120 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, |
115 mark_bit_vector, print_bit_vector, 0, | 121 mark_bit_vector, print_bit_vector, 0, |
116 bit_vector_equal, bit_vector_hash, 0, | 122 bit_vector_equal, bit_vector_hash, |
123 bit_vector_description, | |
117 struct Lisp_Bit_Vector); | 124 struct Lisp_Bit_Vector); |
118 | 125 |
119 DEFUN ("identity", Fidentity, 1, 1, 0, /* | 126 DEFUN ("identity", Fidentity, 1, 1, 0, /* |
120 Return the argument unchanged. | 127 Return the argument unchanged. |
121 */ | 128 */ |
206 retry: | 213 retry: |
207 if (STRINGP (sequence)) | 214 if (STRINGP (sequence)) |
208 return make_int (XSTRING_CHAR_LENGTH (sequence)); | 215 return make_int (XSTRING_CHAR_LENGTH (sequence)); |
209 else if (CONSP (sequence)) | 216 else if (CONSP (sequence)) |
210 { | 217 { |
211 int len; | 218 size_t len; |
212 GET_EXTERNAL_LIST_LENGTH (sequence, len); | 219 GET_EXTERNAL_LIST_LENGTH (sequence, len); |
213 return make_int (len); | 220 return make_int (len); |
214 } | 221 } |
215 else if (VECTORP (sequence)) | 222 else if (VECTORP (sequence)) |
216 return make_int (XVECTOR_LENGTH (sequence)); | 223 return make_int (XVECTOR_LENGTH (sequence)); |
233 which is at least the number of distinct elements. | 240 which is at least the number of distinct elements. |
234 */ | 241 */ |
235 (list)) | 242 (list)) |
236 { | 243 { |
237 Lisp_Object hare, tortoise; | 244 Lisp_Object hare, tortoise; |
238 int len; | 245 size_t len; |
239 | 246 |
240 for (hare = tortoise = list, len = 0; | 247 for (hare = tortoise = list, len = 0; |
241 CONSP (hare) && (! EQ (hare, tortoise) || len == 0); | 248 CONSP (hare) && (! EQ (hare, tortoise) || len == 0); |
242 hare = XCDR (hare), len++) | 249 hare = XCDR (hare), len++) |
243 { | 250 { |
513 copy_list (Lisp_Object list) | 520 copy_list (Lisp_Object list) |
514 { | 521 { |
515 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); | 522 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); |
516 Lisp_Object last = list_copy; | 523 Lisp_Object last = list_copy; |
517 Lisp_Object hare, tortoise; | 524 Lisp_Object hare, tortoise; |
518 int len; | 525 size_t len; |
519 | 526 |
520 for (tortoise = hare = XCDR (list), len = 1; | 527 for (tortoise = hare = XCDR (list), len = 1; |
521 CONSP (hare); | 528 CONSP (hare); |
522 hare = XCDR (hare), len++) | 529 hare = XCDR (hare), len++) |
523 { | 530 { |
914 If SEQ is a string, relevant parts of the string-extent-data are copied | 921 If SEQ is a string, relevant parts of the string-extent-data are copied |
915 to the new string. | 922 to the new string. |
916 */ | 923 */ |
917 (seq, from, to)) | 924 (seq, from, to)) |
918 { | 925 { |
919 int len, f, t; | 926 EMACS_INT len, f, t; |
920 | 927 |
921 if (STRINGP (seq)) | 928 if (STRINGP (seq)) |
922 return Fsubstring (seq, from, to); | 929 return Fsubstring (seq, from, to); |
923 | 930 |
924 if (!LISTP (seq) && !VECTORP (seq) && !BIT_VECTORP (seq)) | 931 if (!LISTP (seq) && !VECTORP (seq) && !BIT_VECTORP (seq)) |
948 args_out_of_range_3 (seq, make_int (f), make_int (t)); | 955 args_out_of_range_3 (seq, make_int (f), make_int (t)); |
949 | 956 |
950 if (VECTORP (seq)) | 957 if (VECTORP (seq)) |
951 { | 958 { |
952 Lisp_Object result = make_vector (t - f, Qnil); | 959 Lisp_Object result = make_vector (t - f, Qnil); |
953 int i; | 960 EMACS_INT i; |
954 Lisp_Object *in_elts = XVECTOR_DATA (seq); | 961 Lisp_Object *in_elts = XVECTOR_DATA (seq); |
955 Lisp_Object *out_elts = XVECTOR_DATA (result); | 962 Lisp_Object *out_elts = XVECTOR_DATA (result); |
956 | 963 |
957 for (i = f; i < t; i++) | 964 for (i = f; i < t; i++) |
958 out_elts[i - f] = in_elts[i]; | 965 out_elts[i - f] = in_elts[i]; |
960 } | 967 } |
961 | 968 |
962 if (LISTP (seq)) | 969 if (LISTP (seq)) |
963 { | 970 { |
964 Lisp_Object result = Qnil; | 971 Lisp_Object result = Qnil; |
965 int i; | 972 EMACS_INT i; |
966 | 973 |
967 seq = Fnthcdr (make_int (f), seq); | 974 seq = Fnthcdr (make_int (f), seq); |
968 | 975 |
969 for (i = f; i < t; i++) | 976 for (i = f; i < t; i++) |
970 { | 977 { |
976 } | 983 } |
977 | 984 |
978 /* bit vector */ | 985 /* bit vector */ |
979 { | 986 { |
980 Lisp_Object result = make_bit_vector (t - f, Qzero); | 987 Lisp_Object result = make_bit_vector (t - f, Qzero); |
981 int i; | 988 EMACS_INT i; |
982 | 989 |
983 for (i = f; i < t; i++) | 990 for (i = f; i < t; i++) |
984 set_bit_vector_bit (XBIT_VECTOR (result), i - f, | 991 set_bit_vector_bit (XBIT_VECTOR (result), i - f, |
985 bit_vector_bit (XBIT_VECTOR (seq), i)); | 992 bit_vector_bit (XBIT_VECTOR (seq), i)); |
986 return result; | 993 return result; |
991 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* | 998 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* |
992 Take cdr N times on LIST, and return the result. | 999 Take cdr N times on LIST, and return the result. |
993 */ | 1000 */ |
994 (n, list)) | 1001 (n, list)) |
995 { | 1002 { |
996 REGISTER int i; | 1003 REGISTER size_t i; |
997 REGISTER Lisp_Object tail = list; | 1004 REGISTER Lisp_Object tail = list; |
998 CHECK_NATNUM (n); | 1005 CHECK_NATNUM (n); |
999 for (i = XINT (n); i; i--) | 1006 for (i = XINT (n); i; i--) |
1000 { | 1007 { |
1001 if (CONSP (tail)) | 1008 if (CONSP (tail)) |
1050 BIT_VECTORP (sequence)) | 1057 BIT_VECTORP (sequence)) |
1051 return Faref (sequence, n); | 1058 return Faref (sequence, n); |
1052 #ifdef LOSING_BYTECODE | 1059 #ifdef LOSING_BYTECODE |
1053 else if (COMPILED_FUNCTIONP (sequence)) | 1060 else if (COMPILED_FUNCTIONP (sequence)) |
1054 { | 1061 { |
1055 int idx = XINT (n); | 1062 EMACS_INT idx = XINT (n); |
1056 if (idx < 0) | 1063 if (idx < 0) |
1057 { | 1064 { |
1058 lose: | 1065 lose: |
1059 args_out_of_range (sequence, n); | 1066 args_out_of_range (sequence, n); |
1060 } | 1067 } |
1102 If N is zero, then the atom that terminates the list is returned. | 1109 If N is zero, then the atom that terminates the list is returned. |
1103 If N is greater than the length of LIST, then LIST itself is returned. | 1110 If N is greater than the length of LIST, then LIST itself is returned. |
1104 */ | 1111 */ |
1105 (list, n)) | 1112 (list, n)) |
1106 { | 1113 { |
1107 int int_n, count; | 1114 EMACS_INT int_n, count; |
1108 Lisp_Object retval, tortoise, hare; | 1115 Lisp_Object retval, tortoise, hare; |
1109 | 1116 |
1110 CHECK_LIST (list); | 1117 CHECK_LIST (list); |
1111 | 1118 |
1112 if (NILP (n)) | 1119 if (NILP (n)) |
1138 Modify LIST to remove the last N (default 1) elements. | 1145 Modify LIST to remove the last N (default 1) elements. |
1139 If LIST has N or fewer elements, nil is returned and LIST is unmodified. | 1146 If LIST has N or fewer elements, nil is returned and LIST is unmodified. |
1140 */ | 1147 */ |
1141 (list, n)) | 1148 (list, n)) |
1142 { | 1149 { |
1143 int int_n; | 1150 EMACS_INT int_n; |
1144 | 1151 |
1145 CHECK_LIST (list); | 1152 CHECK_LIST (list); |
1146 | 1153 |
1147 if (NILP (n)) | 1154 if (NILP (n)) |
1148 int_n = 1; | 1155 int_n = 1; |
2710 noprops: | 2717 noprops: |
2711 signal_simple_error ("Object type has no settable properties", object); | 2718 signal_simple_error ("Object type has no settable properties", object); |
2712 } | 2719 } |
2713 | 2720 |
2714 return value; | 2721 return value; |
2715 } | |
2716 | |
2717 void | |
2718 pure_put (Lisp_Object sym, Lisp_Object prop, Lisp_Object val) | |
2719 { | |
2720 Fput (sym, prop, Fpurecopy (val)); | |
2721 } | 2722 } |
2722 | 2723 |
2723 DEFUN ("remprop", Fremprop, 2, 2, 0, /* | 2724 DEFUN ("remprop", Fremprop, 2, 2, 0, /* |
2724 Remove from OBJECT's property list the property PROPNAME and its | 2725 Remove from OBJECT's property list the property PROPNAME and its |
2725 value. OBJECT can be a symbol, face, extent, or string. Returns | 2726 value. OBJECT can be a symbol, face, extent, or string. Returns |
3174 UNGCPRO; | 3175 UNGCPRO; |
3175 | 3176 |
3176 return result; | 3177 return result; |
3177 } | 3178 } |
3178 | 3179 |
3179 DEFUN ("mapc", Fmapc, 2, 2, 0, /* | 3180 DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /* |
3180 Apply FUNCTION to each element of SEQUENCE. | 3181 Apply FUNCTION to each element of SEQUENCE. |
3181 SEQUENCE may be a list, a vector, a bit vector, or a string. | 3182 SEQUENCE may be a list, a vector, a bit vector, or a string. |
3182 This function is like `mapcar' but does not accumulate the results, | 3183 This function is like `mapcar' but does not accumulate the results, |
3183 which is more efficient if you do not use the results. | 3184 which is more efficient if you do not use the results. |
3185 | |
3186 The difference between this and `mapc' is that `mapc' supports all | |
3187 the spiffy Common Lisp arguments. You should normally use `mapc'. | |
3184 */ | 3188 */ |
3185 (fn, seq)) | 3189 (fn, seq)) |
3186 { | 3190 { |
3187 mapcar1 (XINT (Flength (seq)), 0, fn, seq); | 3191 mapcar1 (XINT (Flength (seq)), 0, fn, seq); |
3188 | 3192 |
3869 DEFSUBR (Fold_equal); | 3873 DEFSUBR (Fold_equal); |
3870 DEFSUBR (Ffillarray); | 3874 DEFSUBR (Ffillarray); |
3871 DEFSUBR (Fnconc); | 3875 DEFSUBR (Fnconc); |
3872 DEFSUBR (Fmapcar); | 3876 DEFSUBR (Fmapcar); |
3873 DEFSUBR (Fmapvector); | 3877 DEFSUBR (Fmapvector); |
3874 DEFSUBR (Fmapc); | 3878 DEFSUBR (Fmapc_internal); |
3875 DEFSUBR (Fmapconcat); | 3879 DEFSUBR (Fmapconcat); |
3876 DEFSUBR (Fload_average); | 3880 DEFSUBR (Fload_average); |
3877 DEFSUBR (Ffeaturep); | 3881 DEFSUBR (Ffeaturep); |
3878 DEFSUBR (Frequire); | 3882 DEFSUBR (Frequire); |
3879 DEFSUBR (Fprovide); | 3883 DEFSUBR (Fprovide); |