comparison src/fns.c @ 28555:976bc44944da

(mapcar1): Test for null vals to support mapc. (Fmapc): New function.
author Dave Love <fx@gnu.org>
date Wed, 12 Apr 2000 17:20:24 +0000
parents b6f06a755c7d
children 3408e0502727
comparison
equal deleted inserted replaced
28554:6d8c15a0df2a 28555:976bc44944da
1 /* Random utility Lisp functions. 1 /* Random utility Lisp functions.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 1999 Free Software Foundation, Inc. 2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000 Free Software Foundation, Inc.
3 3
4 This file is part of GNU Emacs. 4 This file is part of GNU Emacs.
5 5
6 GNU Emacs is free software; you can redistribute it and/or modify 6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by 7 it under the terms of the GNU General Public License as published by
2469 register Lisp_Object tail; 2469 register Lisp_Object tail;
2470 Lisp_Object dummy; 2470 Lisp_Object dummy;
2471 register int i; 2471 register int i;
2472 struct gcpro gcpro1, gcpro2, gcpro3; 2472 struct gcpro gcpro1, gcpro2, gcpro3;
2473 2473
2474 /* Don't let vals contain any garbage when GC happens. */ 2474 if (vals)
2475 for (i = 0; i < leni; i++) 2475 {
2476 vals[i] = Qnil; 2476 /* Don't let vals contain any garbage when GC happens. */
2477 2477 for (i = 0; i < leni; i++)
2478 GCPRO3 (dummy, fn, seq); 2478 vals[i] = Qnil;
2479 gcpro1.var = vals; 2479
2480 gcpro1.nvars = leni; 2480 GCPRO3 (dummy, fn, seq);
2481 gcpro1.var = vals;
2482 gcpro1.nvars = leni;
2483 }
2484 else
2485 GCPRO2 (fn, seq);
2481 /* We need not explicitly protect `tail' because it is used only on lists, and 2486 /* We need not explicitly protect `tail' because it is used only on lists, and
2482 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ 2487 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2483 2488
2484 if (VECTORP (seq)) 2489 if (VECTORP (seq))
2485 { 2490 {
2486 for (i = 0; i < leni; i++) 2491 for (i = 0; i < leni; i++)
2487 { 2492 {
2488 dummy = XVECTOR (seq)->contents[i]; 2493 dummy = XVECTOR (seq)->contents[i];
2489 vals[i] = call1 (fn, dummy); 2494 dummy = call1 (fn, dummy);
2495 if (vals)
2496 vals[i] = dummy;
2490 } 2497 }
2491 } 2498 }
2492 else if (BOOL_VECTOR_P (seq)) 2499 else if (BOOL_VECTOR_P (seq))
2493 { 2500 {
2494 for (i = 0; i < leni; i++) 2501 for (i = 0; i < leni; i++)
2498 if (byte & (1 << (i % BITS_PER_CHAR))) 2505 if (byte & (1 << (i % BITS_PER_CHAR)))
2499 dummy = Qt; 2506 dummy = Qt;
2500 else 2507 else
2501 dummy = Qnil; 2508 dummy = Qnil;
2502 2509
2503 vals[i] = call1 (fn, dummy); 2510 dummy = call1 (fn, dummy);
2511 if (vals)
2512 vals[i] = dummy;
2504 } 2513 }
2505 } 2514 }
2506 else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq)) 2515 else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq))
2507 { 2516 {
2508 /* Single-byte string. */ 2517 /* Single-byte string. */
2509 for (i = 0; i < leni; i++) 2518 for (i = 0; i < leni; i++)
2510 { 2519 {
2511 XSETFASTINT (dummy, XSTRING (seq)->data[i]); 2520 XSETFASTINT (dummy, XSTRING (seq)->data[i]);
2512 vals[i] = call1 (fn, dummy); 2521 dummy = call1 (fn, dummy);
2522 if (vals)
2523 vals[i] = dummy;
2513 } 2524 }
2514 } 2525 }
2515 else if (STRINGP (seq)) 2526 else if (STRINGP (seq))
2516 { 2527 {
2517 /* Multi-byte string. */ 2528 /* Multi-byte string. */
2522 int c; 2533 int c;
2523 int i_before = i; 2534 int i_before = i;
2524 2535
2525 FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte); 2536 FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
2526 XSETFASTINT (dummy, c); 2537 XSETFASTINT (dummy, c);
2527 vals[i_before] = call1 (fn, dummy); 2538 dummy = call1 (fn, dummy);
2539 if (vals)
2540 vals[i_before] = dummy;
2528 } 2541 }
2529 } 2542 }
2530 else /* Must be a list, since Flength did not get an error */ 2543 else /* Must be a list, since Flength did not get an error */
2531 { 2544 {
2532 tail = seq; 2545 tail = seq;
2533 for (i = 0; i < leni; i++) 2546 for (i = 0; i < leni; i++)
2534 { 2547 {
2535 vals[i] = call1 (fn, Fcar (tail)); 2548 dummy = call1 (fn, Fcar (tail));
2549 if (vals)
2550 vals[i] = dummy;
2536 tail = XCDR (tail); 2551 tail = XCDR (tail);
2537 } 2552 }
2538 } 2553 }
2539 2554
2540 UNGCPRO; 2555 UNGCPRO;
2591 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object)); 2606 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
2592 2607
2593 mapcar1 (leni, args, function, sequence); 2608 mapcar1 (leni, args, function, sequence);
2594 2609
2595 return Flist (leni, args); 2610 return Flist (leni, args);
2611 }
2612
2613 DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0,
2614 "Apply FUNCTION to each element of SEQUENCE for side effects only.\n\
2615 Unlike `mapcar', don't accumulate the results. Return SEQUENCE.\n\
2616 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2617 (function, sequence)
2618 Lisp_Object function, sequence;
2619 {
2620 register int leni;
2621
2622 leni = XFASTINT (Flength (sequence));
2623 mapcar1 (leni, 0, function, sequence);
2624
2625 return sequence;
2596 } 2626 }
2597 2627
2598 /* Anything that calls this function must protect from GC! */ 2628 /* Anything that calls this function must protect from GC! */
2599 2629
2600 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, 2630 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
3942 *hash = hash_code; 3972 *hash = hash_code;
3943 3973
3944 start_of_bucket = hash_code % XVECTOR (h->index)->size; 3974 start_of_bucket = hash_code % XVECTOR (h->index)->size;
3945 idx = HASH_INDEX (h, start_of_bucket); 3975 idx = HASH_INDEX (h, start_of_bucket);
3946 3976
3977 /* We need not gcpro idx since it's either an integer or nil. */
3947 while (!NILP (idx)) 3978 while (!NILP (idx))
3948 { 3979 {
3949 int i = XFASTINT (idx); 3980 int i = XFASTINT (idx);
3950 if (EQ (key, HASH_KEY (h, i)) 3981 if (EQ (key, HASH_KEY (h, i))
3951 || (h->cmpfn 3982 || (h->cmpfn
4008 hash_code = h->hashfn (h, key); 4039 hash_code = h->hashfn (h, key);
4009 start_of_bucket = hash_code % XVECTOR (h->index)->size; 4040 start_of_bucket = hash_code % XVECTOR (h->index)->size;
4010 idx = HASH_INDEX (h, start_of_bucket); 4041 idx = HASH_INDEX (h, start_of_bucket);
4011 prev = Qnil; 4042 prev = Qnil;
4012 4043
4044 /* We need not gcpro idx, prev since they're either integers or nil. */
4013 while (!NILP (idx)) 4045 while (!NILP (idx))
4014 { 4046 {
4015 int i = XFASTINT (idx); 4047 int i = XFASTINT (idx);
4016 4048
4017 if (EQ (key, HASH_KEY (h, i)) 4049 if (EQ (key, HASH_KEY (h, i))
4624 return i >= 0 ? HASH_VALUE (h, i) : dflt; 4656 return i >= 0 ? HASH_VALUE (h, i) : dflt;
4625 } 4657 }
4626 4658
4627 4659
4628 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, 4660 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
4629 "Associate KEY with VALUE is hash table TABLE.\n\ 4661 "Associate KEY with VALUE in hash table TABLE.\n\
4630 If KEY is already present in table, replace its current value with\n\ 4662 If KEY is already present in table, replace its current value with\n\
4631 VALUE.") 4663 VALUE.")
4632 (key, value, table) 4664 (key, value, table)
4633 Lisp_Object key, value, table; 4665 Lisp_Object key, value, table;
4634 { 4666 {