PRIMITIVE_RETURN (object);
}
}
-
-DEFINE_PRIMITIVE ("LENGTH", Prim_length, 1, 1,
- "(list)\n\
- Returns the length of LIST.\
- ")
-{
- SCHEME_OBJECT list;
- long i = 0;
- PRIMITIVE_HEADER (1);
-
- list = (ARG_REF (1));
- while (PAIR_P (list))
- {
- i += 1;
- list = (PAIR_CDR (list));
- }
- if (!EMPTY_LIST_P (list))
- error_wrong_type_arg (1);
- PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (i));
-}
-\f
-DEFINE_PRIMITIVE ("MEMQ", Prim_memq, 2, 2,
- "(object list)\n\
- Returns the first pair of LIST whose car is OBJECT;\n\
- the returned pair is always one from which LIST is composed.\n\
- If OBJECT does not occur in LIST, `#f' (n.b.: not the\n\
- empty list) is returned. `memq' uses `eq?' to compare OBJECT with\n\
- the elements of LIST, while `memv' uses `eqv?' and `member' uses\n\
- `equal?'.\n\
- \n\
- (memq 'a '(a b c)) => (a b c)\n\
- (memq 'b '(a b c)) => (b c)\n\
- (memq 'a '(b c d)) => #f\n\
- (memq (list 'a) '(b (a) c)) => #f\n\
- (member (list 'a) '(b (a) c)) => ((a) c)\n\
- (memq 101 '(100 101 102)) => unspecified\n\
- (memv 101 '(100 101 102)) => (101 102)\n\
- \n\
- Although they are often used as predicates, `memq', `memv', and\n\
- `member' do not have question marks in their names because they return\n\
- useful values rather than just `#t' or `#f'.\
- ")
-{
- SCHEME_OBJECT key;
- SCHEME_OBJECT list;
- SCHEME_OBJECT list_key;
- PRIMITIVE_HEADER (2);
- key = (ARG_REF (1));
- list = (ARG_REF (2));
- while (PAIR_P (list))
- {
- list_key = (PAIR_CAR (list));
- if (list_key == key)
- PRIMITIVE_RETURN (list);
- list = (PAIR_CDR (list));
- }
- if (!EMPTY_LIST_P (list))
- error_wrong_type_arg (2);
- PRIMITIVE_RETURN (SHARP_F);
-}
-
-DEFINE_PRIMITIVE ("ASSQ", Prim_assq, 2, 2,
- "(object alist)\n\
- These procedures find the first pair in ALIST whose car field is\n\
- OBJECT, and return that pair; the returned pair is always an\n\
- *element* of ALIST, *not* one of the pairs from which ALIST is\n\
- composed. If no pair in ALIST has OBJECT as its car, `#f' (n.b.:\n\
- not the empty list) is returned. `assq' uses `eq?' to compare\n\
- OBJECT with the car fields of the pairs in ALIST, while `assv'\n\
- uses `eqv?' and `assoc' uses `equal?'.\n\
- \n\
- (define e '((a 1) (b 2) (c 3)))\n\
- (assq 'a e) => (a 1)\n\
- (assq 'b e) => (b 2)\n\
- (assq 'd e) => #f\n\
- (assq (list 'a) '(((a)) ((b)) ((c)))) => #f\n\
- (assoc (list 'a) '(((a)) ((b)) ((c)))) => ((a))\n\
- (assq 5 '((2 3) (5 7) (11 13))) => unspecified\n\
- (assv 5 '((2 3) (5 7) (11 13))) => (5 7)\n\
- \n\
- Although they are often used as predicates, `assq', `assv', and\n\
- `assoc' do not have question marks in their names because they return\n\
- useful values rather than just `#t' or `#f'.\
- ")
-{
- SCHEME_OBJECT key;
- SCHEME_OBJECT alist;
- SCHEME_OBJECT association;
- SCHEME_OBJECT association_key;
- PRIMITIVE_HEADER (2);
-
- key = (ARG_REF (1));
- alist = (ARG_REF (2));
- while (PAIR_P (alist))
- {
- association = (PAIR_CAR (alist));
- if (! (PAIR_P (association)))
- error_wrong_type_arg (2);
- association_key = (PAIR_CAR (association));
- if (association_key == key)
- PRIMITIVE_RETURN (association);
- alist = (PAIR_CDR (alist));
- }
- if (!EMPTY_LIST_P (alist))
- error_wrong_type_arg (2);
- PRIMITIVE_RETURN (SHARP_F);
-}
\f
DEFINE_PRIMITIVE ("SYSTEM-PAIR?", Prim_sys_pair, 1, 1, 0)
{