comparison src/fns.c @ 28555:976bc44944da

(mapcar1): Test for null vals to support mapc. (Fmapc): New function.

28554:6d8c15a0df2a

/* Random utility Lisp functions.
   Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 1999 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by

  register Lisp_Object tail;
  Lisp_Object dummy;
  register int i;
  struct gcpro gcpro1, gcpro2, gcpro3;

  /* Don't let vals contain any garbage when GC happens.  */
  for (i = 0; i < leni; i++)
    vals[i] = Qnil;

  GCPRO3 (dummy, fn, seq);
  gcpro1.var = vals;
  gcpro1.nvars = leni;
  /* We need not explicitly protect `tail' because it is used only on lists, and
    1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */

  if (VECTORP (seq))
    {
      for (i = 0; i < leni; i++)
	{
	  dummy = XVECTOR (seq)->contents[i];
	  vals[i] = call1 (fn, dummy);
	}
    }
  else if (BOOL_VECTOR_P (seq))
    {
      for (i = 0; i < leni; i++)

	  if (byte & (1 << (i % BITS_PER_CHAR)))
	    dummy = Qt;
	  else
	    dummy = Qnil;

	  vals[i] = call1 (fn, dummy);
	}
    }
  else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq))
    {
      /* Single-byte string.  */
      for (i = 0; i < leni; i++)
	{
	  XSETFASTINT (dummy, XSTRING (seq)->data[i]);
	  vals[i] = call1 (fn, dummy);
	}
    }
  else if (STRINGP (seq))
    {
      /* Multi-byte string.  */

	  int c;
	  int i_before = i;

	  FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
	  XSETFASTINT (dummy, c);
	  vals[i_before] = call1 (fn, dummy);
	}
    }
  else   /* Must be a list, since Flength did not get an error */
    {
      tail = seq;
      for (i = 0; i < leni; i++)
	{
	  vals[i] = call1 (fn, Fcar (tail));
	  tail = XCDR (tail);
	}
    }

  UNGCPRO;

  args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));

  mapcar1 (leni, args, function, sequence);

  return Flist (leni, args);
}

/* Anything that calls this function must protect from GC!  */

DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,

    *hash = hash_code;
  
  start_of_bucket = hash_code % XVECTOR (h->index)->size;
  idx = HASH_INDEX (h, start_of_bucket);

  while (!NILP (idx))
    {
      int i = XFASTINT (idx);
      if (EQ (key, HASH_KEY (h, i))
	  || (h->cmpfn

  hash_code = h->hashfn (h, key);
  start_of_bucket = hash_code % XVECTOR (h->index)->size;
  idx = HASH_INDEX (h, start_of_bucket);
  prev = Qnil;

  while (!NILP (idx))
    {
      int i = XFASTINT (idx);

      if (EQ (key, HASH_KEY (h, i))

  return i >= 0 ? HASH_VALUE (h, i) : dflt;
}


DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
  "Associate KEY with VALUE is hash table TABLE.\n\
If KEY is already present in table, replace its current value with\n\
VALUE.")
  (key, value, table)
     Lisp_Object key, value, table;
{

28555:976bc44944da

/* Random utility Lisp functions.
   Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by

  register Lisp_Object tail;
  Lisp_Object dummy;
  register int i;
  struct gcpro gcpro1, gcpro2, gcpro3;

  if (vals)
    {
      /* Don't let vals contain any garbage when GC happens.  */
      for (i = 0; i < leni; i++)
	vals[i] = Qnil;

      GCPRO3 (dummy, fn, seq);
      gcpro1.var = vals;
      gcpro1.nvars = leni;
    }
  else
    GCPRO2 (fn, seq);
  /* We need not explicitly protect `tail' because it is used only on lists, and
    1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */

  if (VECTORP (seq))
    {
      for (i = 0; i < leni; i++)
	{
	  dummy = XVECTOR (seq)->contents[i];
	  dummy = call1 (fn, dummy);
	  if (vals)
	    vals[i] = dummy;
	}
    }
  else if (BOOL_VECTOR_P (seq))
    {
      for (i = 0; i < leni; i++)

	  if (byte & (1 << (i % BITS_PER_CHAR)))
	    dummy = Qt;
	  else
	    dummy = Qnil;

	  dummy = call1 (fn, dummy);
	  if (vals)
	    vals[i] = dummy;
	}
    }
  else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq))
    {
      /* Single-byte string.  */
      for (i = 0; i < leni; i++)
	{
	  XSETFASTINT (dummy, XSTRING (seq)->data[i]);
	  dummy = call1 (fn, dummy);
	  if (vals)
	    vals[i] = dummy;
	}
    }
  else if (STRINGP (seq))
    {
      /* Multi-byte string.  */

	  int c;
	  int i_before = i;

	  FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
	  XSETFASTINT (dummy, c);
	  dummy = call1 (fn, dummy);
	  if (vals)
	    vals[i_before] = dummy;
	}
    }
  else   /* Must be a list, since Flength did not get an error */
    {
      tail = seq;
      for (i = 0; i < leni; i++)
	{
	  dummy = call1 (fn, Fcar (tail));
	  if (vals)
	    vals[i] = dummy;
	  tail = XCDR (tail);
	}
    }

  UNGCPRO;

  args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));

  mapcar1 (leni, args, function, sequence);

  return Flist (leni, args);
}

DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0,
  "Apply FUNCTION to each element of SEQUENCE for side effects only.\n\
Unlike `mapcar', don't accumulate the results.  Return SEQUENCE.\n\
SEQUENCE may be a list, a vector, a bool-vector, or a string.")
  (function, sequence)
     Lisp_Object function, sequence;
{
  register int leni;

  leni = XFASTINT (Flength (sequence));
  mapcar1 (leni, 0, function, sequence);

  return sequence;
}

/* Anything that calls this function must protect from GC!  */

DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,

    *hash = hash_code;
  
  start_of_bucket = hash_code % XVECTOR (h->index)->size;
  idx = HASH_INDEX (h, start_of_bucket);

  /* We need not gcpro idx since it's either an integer or nil.  */
  while (!NILP (idx))
    {
      int i = XFASTINT (idx);
      if (EQ (key, HASH_KEY (h, i))
	  || (h->cmpfn

  hash_code = h->hashfn (h, key);
  start_of_bucket = hash_code % XVECTOR (h->index)->size;
  idx = HASH_INDEX (h, start_of_bucket);
  prev = Qnil;

  /* We need not gcpro idx, prev since they're either integers or nil.  */
  while (!NILP (idx))
    {
      int i = XFASTINT (idx);

      if (EQ (key, HASH_KEY (h, i))

  return i >= 0 ? HASH_VALUE (h, i) : dflt;
}


DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
  "Associate KEY with VALUE in hash table TABLE.\n\
If KEY is already present in table, replace its current value with\n\
VALUE.")
  (key, value, table)
     Lisp_Object key, value, table;
{