comparison src/fns.c @ 207:e45d5e7c476e r20-4b2

Import from CVS: tag r20-4b2
author cvs
date Mon, 13 Aug 2007 10:03:52 +0200
parents eb5470882647
children 41ff10fd062f
comparison
equal deleted inserted replaced
206:d3e9274cbc4e 207:e45d5e7c476e
2884 if (EQ_WITH_EBOLA_NOTICE (o1, o2)) 2884 if (EQ_WITH_EBOLA_NOTICE (o1, o2))
2885 return 1; 2885 return 1;
2886 /* Note that (equal 20 20.0) should be nil */ 2886 /* Note that (equal 20 20.0) should be nil */
2887 else if (XTYPE (o1) != XTYPE (o2)) 2887 else if (XTYPE (o1) != XTYPE (o2))
2888 return 0; 2888 return 0;
2889 #ifndef LRECORD_CONS
2889 else if (CONSP (o1)) 2890 else if (CONSP (o1))
2890 { 2891 {
2891 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1)) 2892 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1))
2892 return 0; 2893 return 0;
2893 o1 = XCDR (o1); 2894 o1 = XCDR (o1);
2894 o2 = XCDR (o2); 2895 o2 = XCDR (o2);
2895 goto do_cdr; 2896 goto do_cdr;
2896 } 2897 }
2897 2898 #endif
2898 #ifndef LRECORD_VECTOR 2899 #ifndef LRECORD_VECTOR
2899 else if (VECTORP (o1)) 2900 else if (VECTORP (o1))
2900 { 2901 {
2901 int indice; 2902 int indice;
2902 int len = XVECTOR_LENGTH (o1); 2903 int len = XVECTOR_LENGTH (o1);
2910 if (!internal_equal (v1, v2, depth + 1)) 2911 if (!internal_equal (v1, v2, depth + 1))
2911 return 0; 2912 return 0;
2912 } 2913 }
2913 return 1; 2914 return 1;
2914 } 2915 }
2915 #endif /* !LRECORD_VECTOR */ 2916 #endif
2917 #ifndef LRECORD_STRING
2916 else if (STRINGP (o1)) 2918 else if (STRINGP (o1))
2917 { 2919 {
2918 Bytecount len = XSTRING_LENGTH (o1); 2920 Bytecount len = XSTRING_LENGTH (o1);
2919 if (len != XSTRING_LENGTH (o2)) 2921 if (len != XSTRING_LENGTH (o2))
2920 return 0; 2922 return 0;
2921 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len)) 2923 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len))
2922 return 0; 2924 return 0;
2923 return 1; 2925 return 1;
2924 } 2926 }
2927 #endif
2925 else if (LRECORDP (o1)) 2928 else if (LRECORDP (o1))
2926 { 2929 {
2927 CONST struct lrecord_implementation 2930 CONST struct lrecord_implementation
2928 *imp1 = XRECORD_LHEADER (o1)->implementation, 2931 *imp1 = XRECORD_LHEADER (o1)->implementation,
2929 *imp2 = XRECORD_LHEADER (o2)->implementation; 2932 *imp2 = XRECORD_LHEADER (o2)->implementation;
2954 if (HACKEQ_UNSAFE (o1, o2)) 2957 if (HACKEQ_UNSAFE (o1, o2))
2955 return 1; 2958 return 1;
2956 /* Note that (equal 20 20.0) should be nil */ 2959 /* Note that (equal 20 20.0) should be nil */
2957 else if (XTYPE (o1) != XTYPE (o2)) 2960 else if (XTYPE (o1) != XTYPE (o2))
2958 return 0; 2961 return 0;
2962 #ifndef LRECORD_CONS
2959 else if (CONSP (o1)) 2963 else if (CONSP (o1))
2960 { 2964 {
2961 if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1)) 2965 if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1))
2962 return 0; 2966 return 0;
2963 o1 = XCDR (o1); 2967 o1 = XCDR (o1);
2964 o2 = XCDR (o2); 2968 o2 = XCDR (o2);
2965 goto do_cdr; 2969 goto do_cdr;
2966 } 2970 }
2967 2971 #endif
2968 #ifndef LRECORD_VECTOR 2972 #ifndef LRECORD_VECTOR
2969 else if (VECTORP (o1)) 2973 else if (VECTORP (o1))
2970 { 2974 {
2971 int indice; 2975 int indice;
2972 int len = XVECTOR_LENGTH (o1); 2976 int len = XVECTOR_LENGTH (o1);
2979 depth + 1)) 2983 depth + 1))
2980 return 0; 2984 return 0;
2981 } 2985 }
2982 return 1; 2986 return 1;
2983 } 2987 }
2984 #endif /* !LRECORD_VECTOR */ 2988 #endif
2989 #ifndef LRECORD_STRING
2985 else if (STRINGP (o1)) 2990 else if (STRINGP (o1))
2986 { 2991 {
2987 Bytecount len = XSTRING_LENGTH (o1); 2992 Bytecount len = XSTRING_LENGTH (o1);
2988 if (len != XSTRING_LENGTH (o2)) 2993 if (len != XSTRING_LENGTH (o2))
2989 return 0; 2994 return 0;
2990 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len)) 2995 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len))
2991 return 0; 2996 return 0;
2992 return 1; 2997 return 1;
2993 } 2998 }
2999 #endif
2994 else if (LRECORDP (o1)) 3000 else if (LRECORDP (o1))
2995 { 3001 {
2996 CONST struct lrecord_implementation 3002 CONST struct lrecord_implementation
2997 *imp1 = XRECORD_LHEADER (o1)->implementation, 3003 *imp1 = XRECORD_LHEADER (o1)->implementation,
2998 *imp2 = XRECORD_LHEADER (o2)->implementation; 3004 *imp2 = XRECORD_LHEADER (o2)->implementation;
3338 } 3344 }
3339 3345
3340 3346
3341 Lisp_Object Vfeatures; 3347 Lisp_Object Vfeatures;
3342 3348
3349 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
3350 Return non-nil if feature FEXP is present in this Emacs.
3351 Use this to conditionalize execution of lisp code based on the
3352 presence or absence of emacs or environment extensions.
3353 FEXP can be a symbol, a number, or a list.
3354 If a symbol, it will be looked up in the `features' variable, and
3355 non-nil will be returned if it is found.
3356 If FEXP is a number, the function will return non-nil if this Emacs
3357 has an equal or greater version number than FEXP.
3358 If FEXP is a list whose car is the symbol `and', it will return
3359 non-nil if all the features in its cdr are non-nil.
3360 If FEXP is a list whose car is the symbol `or', it will return non-nil
3361 if any of the features in its cdr are non-nil.
3362 If FEXP is a list whose car is the symbol `not', it will return
3363 non-nil if the feature is not present.
3364 */
3365 (fexp))
3366 {
3343 #ifndef FEATUREP_SYNTAX 3367 #ifndef FEATUREP_SYNTAX
3344 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* 3368 CHECK_SYMBOL (fexp);
3345 Return t if FEATURE is present in this Emacs. 3369 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
3346 Use this to conditionalize execution of lisp code based on the 3370 #else /* FEATUREP_SYNTAX */
3347 presence or absence of emacs or environment extensions. 3371 extern Lisp_Object Vemacs_major_version, Vemacs_minor_version;
3348 Use `provide' to declare that a feature is available.
3349 This function looks at the value of the variable `features'.
3350 */
3351 (feature))
3352 {
3353 CHECK_SYMBOL (feature);
3354 return NILP (Fmemq (feature, Vfeatures)) ? Qnil : Qt;
3355 }
3356 #else
3357 extern Lisp_Object Vemacs_major_version, Vemacs_minor_version;
3358
3359 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
3360 Return non-nil if feature expression FEXP is true.
3361 */
3362 (fexp))
3363 {
3364 static double featurep_emacs_version; 3372 static double featurep_emacs_version;
3365 3373
3366 /* Brute force translation from Erik Naggum's lisp function. */ 3374 /* Brute force translation from Erik Naggum's lisp function. */
3367 if (SYMBOLP(fexp)) 3375 if (SYMBOLP(fexp))
3368 { 3376 {
3385 Lisp_Object tem; 3393 Lisp_Object tem;
3386 3394
3387 tem = XCAR(fexp); 3395 tem = XCAR(fexp);
3388 if (EQ(tem, Qnot)) 3396 if (EQ(tem, Qnot))
3389 { 3397 {
3390 Lisp_Object negate = XCDR(fexp); 3398 Lisp_Object negate;
3391 3399
3392 if (!NILP(XCDR(fexp))) 3400 tem = XCDR (fexp);
3401 negate = Fcar (tem);
3402 if (!NILP (tem))
3403 return NILP (Ffeaturep (negate)) ? Qt : Qnil;
3404 else
3405 return Fsignal (Qinvalid_read_syntax, list1 (tem));
3406 }
3407 else if (EQ(tem, Qand))
3408 {
3409 tem = XCDR(fexp);
3410 /* Use Fcar/Fcdr for error-checking. */
3411 while (!NILP (tem) && !NILP (Ffeaturep (Fcar (tem))))
3393 { 3412 {
3394 return Fsignal(Qinvalid_read_syntax, list1(XCDR(fexp))); 3413 tem = Fcdr (tem);
3395 }
3396 else
3397 {
3398 return NILP(Ffeaturep(negate)) ? Qt : Qnil;
3399 }
3400 }
3401 else if (EQ(tem, Qand))
3402 {
3403 tem = XCDR(fexp);
3404 while (!NILP(tem) && !NILP(Ffeaturep(XCAR(tem))))
3405 {
3406 tem = XCDR(tem);
3407 } 3414 }
3408 return NILP(tem) ? Qt : Qnil; 3415 return NILP(tem) ? Qt : Qnil;
3409 } 3416 }
3410 else if (EQ(tem, Qor)) 3417 else if (EQ(tem, Qor))
3411 { 3418 {
3412 tem = XCDR(fexp); 3419 tem = XCDR (fexp);
3413 while (!NILP(tem) && NILP(Ffeaturep(XCAR(tem)))) 3420 /* Use Fcar/Fcdr for error-checking. */
3421 while (!NILP (tem) && NILP (Ffeaturep (Fcar (tem))))
3414 { 3422 {
3415 tem = XCDR(tem); 3423 tem = Fcdr (tem);
3416 } 3424 }
3417 return NILP(tem) ? Qnil : Qt; 3425 return NILP(tem) ? Qnil : Qt;
3418 } 3426 }
3419 else 3427 else
3420 { 3428 {