iterators.cmod

/* -*- c -*-
|| This file is part of Pike. For copyright information see COPYRIGHT.
|| Pike is distributed under GPL, LGPL and MPL. See the file COPYING
|| for more information.
|| $Id: iterators.cmod,v 1.54 2004/04/06 15:37:55 nilsson Exp $
*/

#include "global.h"
RCSID("$Id: iterators.cmod,v 1.54 2004/04/06 15:37:55 nilsson Exp $");
#include "main.h"
#include "object.h"
#include "mapping.h"
#include "multiset.h"
#include "svalue.h"
#include "array.h"
#include "pike_macros.h"
#include "pike_error.h"
#include "pike_memory.h"
#include "dynamic_buffer.h"
#include "interpret.h"
#include "las.h"
#include "gc.h"
#include "stralloc.h"
#include "pike_security.h"
#include "opcodes.h"
#include "pike_error.h"
#include "program.h"
#include "operators.h"
#include "builtin_functions.h"
#include "constants.h"

#define sp Pike_sp

DECLARATIONS

/*! @class Iterator
 *!
 *! This is the interface for iterator objects. They implement an
 *! interface to a collection or stream of data items and a cursor
 *! that can be used to iterate over and examine individual items in
 *! the data set.
 *!
 *! Iterators are typically created to access a data set in some
 *! specific object, array, mapping, multiset or string. An object can
 *! have several iterators that access different data sets in it, or
 *! the same in different ways. E.g. strings have both an iterator for
 *! access char-by-char (@[String.Iterator]), and another for access
 *! over splitted substrings (@[String.SplitIterator]).
 *! @[lfun::_get_iterator] may be defined in an object to get an
 *! instance of the canonical iterator type for it. It's used by e.g.
 *! @[foreach] to iterate over objects conveniently.
 *!
 *! It's not an error to advance an iterator past the beginning or end
 *! of the data set; @[`!()] will only return true then, and @[index]
 *! and @[value] will return @[UNDEFINED]. An iterator in that state
 *! need not keep track of positions, so it's undefined what happens
 *! if it's "moved back" into the set of items.
 *!
 *! Backward movement for iterators is optional. It's supported if and
 *! only if @[`-()] is defined, but even then it's undefined how far
 *! back the iterator can move. Therefore iterators may support only a
 *! limited amount of backward movement, e.g. when they access a
 *! stream through a limited buffer. If such an iterator is moved back
 *! past the limit then it'll behave as if it's pointing entirely
 *! outside the data set (see above).
 *!
 *! An iterator that doesn't support backward movement at all should
 *! throw an error if it's attempted.
 *!
 *! @seealso
 *!   @[predef::get_iterator], @[lfun::_get_iterator],
 *!   @[Array.Iterator], @[Mapping.Iterator], @[Multiset.Iterator],
 *!   @[String.Iterator], @[String.SplitIterator].
 */

PIKECLASS Iterator
{
  /*! @decl void create (void|mixed data)
   *!
   *! Initialize this iterator to access a data set in @[data]. The
   *! type of @[data] is specific to the iterator implementation. An
   *! iterator may also access some implicit data set, in which case
   *! @[data] isn't specified at all.
   *!
   *! The iterator initially points to the first item in the data set,
   *! if there is any.
   *!
   *! The iterator need not support being reused, so this function is
   *! typically static.
   */
  PIKEFUN void create(void|mixed data)
    flags ID_STATIC;
    prototype;
  {}

  /*! @decl int(0..1) `!()
   *!
   *! Returns @expr{0@} (zero) when the iterator points to an item,
   *! @expr{1@} otherwise.
   */
  PIKEFUN int(0..1) `!()
    flags ID_STATIC;
    prototype;
  {}

  /*! @decl Iterator `+ (int steps)
   *!
   *! Returns a clone of this iterator which is advanced the specified
   *! number of steps. The amount may be negative to move backwards.
   *! If the iterator doesn't support backward movement it should
   *! throw an exception in that case.
   */
  PIKEFUN Iterator `+(int steps)
    flags ID_STATIC;
    prototype;
  {}

  /*! @decl Iterator `+= (int steps)
   *!
   *! Advance this iterator the specified number of steps and return
   *! it. The amount may be negative to move backwards. If the
   *! iterator doesn't support backward movement it should throw an
   *! exception in that case.
   *!
   *! @[foreach] calls this function with a step value of @expr{1@}.
   *!
   *! @note
   *!   @[foreach] will call this function even when the the
   *!   iterator has more than one reference. If you want to
   *!   loop over a copy of the iterator, you can create a
   *!   copy by adding @expr{0@} (zero) to it:
   *!   @code
   *!     Iterator iterator;
   *!     ...
   *!     foreach(iterator+0; mixed index; mixed value) {
   *!       ...
   *!     }
   *!   @endcode
   *!
   *! @note
   *!   Even though this function is an lfun, it is often beneficial
   *!   to not declare it static, since code might want to advance
   *!   the iterator by hand.
   */
  PIKEFUN Iterator `+=(int steps)
    prototype;
  {}

  /*! @decl optional Iterator `- (int steps)
   *!
   *! This lfun should be defined if and only if the iterator supports
   *! backward movement to some degree. It should back up the
   *! specified number of steps. The amount may be negative to move
   *! forward.
   */
  PIKEFUN int(0..1) `-(int steps)
    flags ID_STATIC|ID_OPTIONAL;
    prototype;
  {}

  /*! @decl mixed index()
   *!
   *! Returns the current index, or @[UNDEFINED] if the iterator
   *! doesn't point to any item.
   *!
   *! If there's no obvious index set then the index is the current
   *! position in the data set, counting from @expr{0@}.
   */
  PIKEFUN mixed index()
    prototype;
  {}

  /*! @decl mixed value()
   *!
   *! Returns the current value, or @[UNDEFINED] if the iterator
   *! doesn't point to any item.
   */
  PIKEFUN mixed value()
    prototype;
  {}

  /*! @decl optional int _sizeof()
   *!
   *! Returns the total number of items in the data set according to
   *! this iterator. If the size of the data set is unlimited or
   *! unknown then this function shouldn't be defined.
   */
  PIKEFUN int _sizeof()
    flags ID_OPTIONAL;
    prototype;
  {}

  /*! @decl optional void _random()
   *!
   *! If this function is defined then it sets the iterator to point
   *! to a random item in the accessible set. The random distribution
   *! should be rectangular within that set, and the pseudorandom
   *! sequence provided by @[random] should be used.
   */
  PIKEFUN void _random()
    flags ID_OPTIONAL;
    prototype;
  {}

  /*! @decl optional int(0..1) first()
   *!
   *! If this function is defined then it resets the iterator to point
   *! to the first item.
   *!
   *! @returns
   *!   Returns zero if there are no items at all in
   *!   the data set, one otherwise.
   *!
   *! @note
   *!   It's not enough to set the iterator to the earliest accessible
   *!   item. If the iterator doesn't support backing up to the
   *!   original start position then this function should not be
   *!   implemented.
   */
  PIKEFUN int(0..1) first()
    flags ID_OPTIONAL;
    prototype;
  {}

  /*! @decl optional int next()
   *!
   *! If this function is defined it should advance the iterator one
   *! step, just like @expr{@[`+=](1)@} would do.
   *!
   *! @returns
   *!   Returns @tt{1@} if it succeeded in advancing, and
   *!   @tt{0@} (zero) at end of iterator.
   */
  PIKEFUN int(0..1) next()
    flags ID_OPTIONAL;
    prototype;
  {}

  /*! @decl optional void set_index(zero index)
   *!
   *! If this function is defined it should set the iterator at
   *! the specified index.
   *!
   *! @note
   *!   It should be possible to set the index at the end of
   *!   the iterator.
   */
  PIKEFUN void set_index(zero index)
    flags ID_OPTIONAL;
    prototype;
  {}
}

/*! @endclass
 */

/*! @module Mapping
 */
/*! @class Iterator
 *! @inherit predef::Iterator
 *!
 *!   An object of this class is returned by @[get_iterator()] when
 *!   called with a mapping.
 *!
 *! @seealso
 *!   @[get_iterator]
 */
PIKECLASS mapping_iterator
{
  /* All variables *must* be before all functions! */
  CVAR int bucket;
  CVAR struct mapping *m;
  CVAR struct mapping_data *md;
  CVAR struct keypair *current;

  PIKEFUN mixed value()
    {
      if(THIS->current)
	push_svalue(& THIS->current->val);
      else
      {
	push_undefined();
      }
    }

  PIKEFUN mixed index()
    {
      if(THIS->current)
	push_svalue(& THIS->current->ind);
      else
      {
	push_undefined();
      }
    }

  static int step_bucket(struct mapping_iterator_struct *i)
    {
      if (i->md) {
	while(! i->current)
	{
	  i->bucket++;
	  if(i->bucket >= i->md->hashsize)
	    return 0;
	  i->current=i->md->hash[i->bucket];
	}
      }
      return 1;
    }

  static int mi_step(struct mapping_iterator_struct *i)
    {
      if(! i->current) return 0;
      i->current=i->current->next;
      return step_bucket(i);
    }
  
  PIKEFUN object `+(int(0..) steps)
    {
      struct object *o=low_clone(mapping_iterator_program);
      if (steps < 0)
	SIMPLE_ARG_ERROR ("Mapping.Iterator.`+", 1,
			  "This iterator doesn't support going backwards.\n");
      OBJ2_MAPPING_ITERATOR(o)[0] = *THIS;
      if (THIS->m)
	add_ref(THIS->m);
      if (THIS->md) {
	add_ref(THIS->md);
	THIS->md->valrefs++;
      }
      while(--steps>=0 && mi_step(OBJ2_MAPPING_ITERATOR(o)));
      RETURN o;
    }

  PIKEFUN object `+=(int(0..) steps)
    {
      if (steps < 0)
	SIMPLE_ARG_ERROR ("Mapping.Iterator.`+=", 1,
			  "This iterator doesn't support going backwards.\n");
      while(--steps>=0 && mi_step(THIS));
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN int first()
    {
      THIS->current=0;
      THIS->bucket=-1;
      RETURN step_bucket(THIS);
    }

  /* Hubbe: Should this really be destructive ?? */
  PIKEFUN object _random()
    {
      if(THIS->md && THIS->md->hashsize)
      {
	size_t k;
	struct keypair *tmp;
	THIS->bucket=my_rand() % THIS->md->hashsize;
	k=0;
	for(tmp=THIS->md->hash[THIS->bucket];tmp;tmp=tmp->next) k++;
	tmp=THIS->md->hash[THIS->bucket];
	if(k)
	{
	  k=my_rand() % k;
	  while(--k > 0) tmp=tmp->next;
	}
	THIS->current=tmp;
      }else{
	THIS->bucket=-1;
	THIS->current=0;
      }
      step_bucket(THIS);
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN int next() { RETURN mi_step(THIS); }
  PIKEFUN int `!() { RETURN !THIS->current; }

  PIKEFUN void create(mapping map)
    {
      if(THIS->m)
	Pike_error("Mapping iterators cannot be reused.\n");

      add_ref(THIS->m=map);
      THIS->md=map->data;
      add_ref(THIS->md);
      THIS->md->valrefs++;
      THIS->bucket=-1;
      step_bucket(THIS);
    }

  INIT
    {
      THIS->m=0;
      THIS->md=0;
      THIS->current=0;
      THIS->bucket=0;
    }

  EXIT
    {
      if (THIS->md) {
	THIS->md->valrefs--;
	free_mapping_data(THIS->md);
      }
      if (THIS->m) {
	free_mapping(THIS->m);
      }
    }
};
/*! @endclass
 */
/*! @endmodule
 */


/*! @module Array
 */
/*! @class Iterator
 *! @inherit predef::Iterator
 *!
 *!   An object of this class is returned by @[get_iterator()] when
 *!   called with an array.
 *!
 *! @seealso
 *!   @[get_iterator]
 */
PIKECLASS array_iterator
{
  CVAR int pos;
  CVAR struct array *a;
  
  PIKEFUN mixed value()
    {
      if(!THIS->a || THIS->pos < 0 || THIS->pos >= THIS->a->size)
      {
	push_undefined();
      }else{
	push_svalue(THIS->a->item + THIS->pos);
      }
    }

  PIKEFUN int index()
    {
      if(!THIS->a || THIS->pos < 0 || THIS->pos >= THIS->a->size)
      {
	push_undefined();
      }else{
	RETURN THIS->pos;
      }
    }

  PIKEFUN object `+(int steps)
    {
      struct object *o=low_clone(array_iterator_program);
      OBJ2_ARRAY_ITERATOR(o)[0]=*THIS;
      if (THIS->a)
	add_ref(THIS->a);
      OBJ2_ARRAY_ITERATOR(o)->pos+=steps;
      RETURN o;
    }

  PIKEFUN object `+=(int steps)
  {
    THIS->pos+=steps;
    REF_RETURN Pike_fp->current_object;
  }

  PIKEFUN object `-(int steps)
  {
    struct object *o=low_clone(array_iterator_program);
    OBJ2_ARRAY_ITERATOR(o)[0]=*THIS;
    add_ref(THIS->a);
    OBJ2_ARRAY_ITERATOR(o)->pos-=steps;
    RETURN o;
  }

  PIKEFUN int first()
    {
      THIS->pos=0;
      RETURN THIS->a && THIS->pos < THIS->a->size;
    }

  PIKEFUN void set_index(int pos)
    {
      if(!THIS->a || pos < 0 || pos > THIS->a->size)
      {
	Pike_error("Bad position.\n");
      }else{
	THIS->pos = pos;
      }      
    }

  /* Hubbe: Should this really be destructive ?? */
  PIKEFUN object _random()
    {
      if(THIS->a && THIS->a->size)
	THIS->pos=my_rand() % THIS->a->size;
      else
	THIS->pos=0;
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN int next()
    {
      THIS->pos++;
      RETURN THIS->a && THIS->pos >= 0 && THIS->pos < THIS->a->size;
    }

  PIKEFUN int `!()
    {
      RETURN !(THIS->a && THIS->pos >= 0 && THIS->pos < THIS->a->size);
    }

  PIKEFUN void create(array a)
    {
      if(THIS->a)
	Pike_error("Array iterators cannot be reused.\n");
      
      add_ref(THIS->a=a);
    }
  
  INIT 
    {
      THIS->a=0;
      THIS->pos=0;
    }

  EXIT
    {
      if (THIS->a)
	free_array(THIS->a);
    }
    
};

/*! @endclass
 */
/*! @endmodule
 */

/*! @module Multiset
 */
/*! @class Iterator
 *! @inherit predef::Iterator
 *!
 *!   An object of this class is returned by @[get_iterator()] when
 *!   called with a multiset.
 *!
 *! @seealso
 *!   @[get_iterator]
 */
PIKECLASS multiset_iterator
{
  CVAR struct multiset *l;
  CVAR int lock_index;
  CVAR ptrdiff_t nodepos;

  PIKEFUN int value()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (THIS->nodepos < 0 || msnode_is_deleted (THIS->l, THIS->nodepos))
	push_undefined();
      else
	push_multiset_value (THIS->l, THIS->nodepos);
    }

  PIKEFUN mixed index()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (THIS->nodepos < 0 || msnode_is_deleted (THIS->l, THIS->nodepos))
	push_undefined();
      else
	push_multiset_index (THIS->l, THIS->nodepos);
    }

  static struct object *li_copy (struct multiset_iterator_struct *li)
    {
      struct object *o = low_clone (multiset_iterator_program);
      struct multiset_iterator_struct *copy = OBJ2_MULTISET_ITERATOR (o);
      if ((copy->l = li->l))
	add_ref(li->l);
      if ((copy->nodepos = li->nodepos) >= 0) add_msnode_ref (copy->l);
      if ((copy->lock_index = li->lock_index)) {
	add_ref (copy->l->msd);
	copy->l->msd->noval_refs++;
      }
      return o;
    }

  static void li_step (struct multiset_iterator_struct *li, int steps)
    {
      ptrdiff_t newpos = li->nodepos;

      if (li->nodepos < 0) return;

      if (steps > 0)
	do {
	  newpos = multiset_next (li->l, newpos);
	  if (newpos < 0) {
	    sub_msnode_ref (li->l);
	    break;
	  }
	} while (--steps);
      else if (steps < 0)
	do {
	  newpos = multiset_prev (li->l, newpos);
	  if (newpos < 0) {
	    sub_msnode_ref (li->l);
	    break;
	  }
	} while (++steps);

      li->nodepos = newpos;
    }

  PIKEFUN object `+= (int steps)
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      li_step (THIS, steps);
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN object `+ (int steps)
    {
      struct object *o;
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      o = li_copy (THIS);
      li_step (OBJ2_MULTISET_ITERATOR (o), steps);
      RETURN o;
    }

  PIKEFUN object `- (int steps)
    {
      struct object *o;
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      o = li_copy (THIS);
      li_step (OBJ2_MULTISET_ITERATOR (o), -steps);
      RETURN o;
    }

  PIKEFUN int first()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (THIS->nodepos >= 0) sub_msnode_ref (THIS->l);
      THIS->nodepos = multiset_first (THIS->l);
      RETURN THIS->nodepos >= 0;
    }

  PIKEFUN int next()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (THIS->nodepos >= 0) {
	THIS->nodepos = multiset_next (THIS->l, THIS->nodepos);
	if (THIS->nodepos >= 0) RETURN 1;
	sub_msnode_ref (THIS->l);
      }
      RETURN 0;
    }

  PIKEFUN int `!()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      RETURN THIS->nodepos < 0 || msnode_is_deleted (THIS->l, THIS->nodepos);
    }

  /* Hubbe: Should this really be destructive ??
   * I let this question stand; I'm only adapting multiset_iterator. /mast */
  PIKEFUN object _random()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (THIS->nodepos >= 0) {
	sub_msnode_ref (THIS->l);
	THIS->nodepos = -1;
      }
      if (!multiset_is_empty (THIS->l))
	THIS->nodepos =
	  multiset_get_nth (THIS->l, my_rand() % multiset_sizeof (THIS->l));
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN void lock_index()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (!THIS->lock_index) {
	add_ref (THIS->l->msd);
	THIS->l->msd->noval_refs++;
	THIS->lock_index = 1;
      }
    }

  PIKEFUN void unlock_index()
    {
      if (!THIS->l) Pike_error ("Iterator not initialized.\n");
      if (THIS->lock_index) {
	THIS->l->msd->noval_refs--;
	sub_ref (THIS->l->msd);
#ifdef PIKE_DEBUG
	if (THIS->l->msd->refs <= 0) Pike_fatal ("msd ran out of refs unexpectedly.\n");
#endif
	THIS->lock_index = 0;
      }
    }

  /* FIXME: Add more functions, e.g. insert, delete, add. */

  /* FIXME: Maybe the index should be locked when the iterator is used
   * in foreach, to behave more like the mapping iterator. */

  PIKEFUN void create (multiset l)
    {
      if (THIS->l) Pike_error ("Multiset iterators cannot be reused.\n");
      add_ref (THIS->l = l);
      THIS->lock_index = 0;
      THIS->nodepos = multiset_first (THIS->l);
    }

  INIT 
    {
      THIS->l = NULL;
    }

  EXIT
    {
      if (THIS->l) {
	if (THIS->nodepos >= 0) sub_msnode_ref (THIS->l);
	if (THIS->lock_index) {
	  THIS->l->msd->noval_refs--;
	  sub_ref (THIS->l->msd);
#ifdef PIKE_DEBUG
	  if (THIS->l->msd->refs <= 0) Pike_fatal ("msd ran out of refs unexpectedly.\n");
#endif
	}
	free_multiset (THIS->l);
	THIS->l = NULL;
      }
    }
};

/*! @endclass
 */
/*! @endmodule
 */

/*! @module String
 */
/*! @class Iterator
 *! @inherit predef::Iterator
 *!
 *!   An object of this class is returned by @[get_iterator()] when
 *!   called with a string.
 *!
 *! @seealso
 *!   @[get_iterator]
 */
PIKECLASS string_iterator
{
  CVAR int pos;
  CVAR struct pike_string *s;
  
  PIKEFUN int value()
    {
      if(!THIS->s || THIS->pos < 0 || THIS->pos >= THIS->s->len)
      {
	push_undefined();
      }else{
	RETURN index_shared_string(THIS->s, THIS->pos);
      }
    }

  PIKEFUN int index()
    {
      if(!THIS->s || THIS->pos < 0 || THIS->pos >= THIS->s->len)
      {
	push_undefined();
      }else{
	RETURN THIS->pos;
      }
    }

  PIKEFUN object `+(int steps)
    {
      struct object *o=low_clone(string_iterator_program);
      OBJ2_STRING_ITERATOR(o)[0]=*THIS;
      add_ref(THIS->s);
      OBJ2_STRING_ITERATOR(o)->pos+=steps;
      RETURN o;
    }

  PIKEFUN object `+=(int steps)
  {
    THIS->pos+=steps;
    REF_RETURN Pike_fp->current_object;
  }

  PIKEFUN object `-(int steps)
  {
    struct object *o=low_clone(string_iterator_program);
    OBJ2_STRING_ITERATOR(o)[0]=*THIS;
    add_ref(THIS->s);
    OBJ2_STRING_ITERATOR(o)->pos-=steps;
    RETURN o;
  }

  PIKEFUN int first()
    {
      THIS->pos=0;
      RETURN THIS->s && THIS->pos < THIS->s->len;
    }

  PIKEFUN void set_index(int pos)
    {
      if (!THIS->s || pos < 0 || pos > THIS->s->len) {
	Pike_error("Bad position.\n");
      }
      THIS->pos = pos;
    }

  /* Hubbe: Should this really be destructive ?? */
  PIKEFUN object _random()
    {
      if(THIS->s->len)
	THIS->pos=my_rand() % THIS->s->len;
      else
	THIS->pos=0;
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN int next()
    {
      THIS->pos++;
      RETURN THIS->s && THIS->pos >= 0 && THIS->pos < THIS->s->len;
    }

  PIKEFUN int `!()
    {
      RETURN !(THIS->s && THIS->pos >= 0 && THIS->pos < THIS->s->len);
    }

  PIKEFUN int _search(string|int needle, int|void start)
    flags ID_STATIC;
    {
      if (!THIS->s)
	Pike_error("No data to search.\n");
      ref_push_string(THIS->s);
      push_svalue(needle);
      if (start) push_svalue(start);
      else push_int(THIS->pos);
      f_search(3);
      stack_pop_n_elems_keep_top(args);
      /* Advance to the found position. */
      if (Pike_sp[-1].type == T_INT) {
	if (Pike_sp[-1].u.integer >= 0) {
	  THIS->pos = Pike_sp[-1].u.integer;
	} else {
	  THIS->pos = THIS->s->len;
	}
      }
    }

  PIKEFUN void create(string s)
    {
      if(THIS->s)
	Pike_error("String iterators cannot be reused.\n");
      
      add_ref(THIS->s=s);
    }
  
  INIT 
    {
      THIS->s=0;
      THIS->pos=0;
    }

  EXIT
    {
      free_string(THIS->s);
    }
};

/*! @endclass
 */
/*! @endmodule
 */

/* Interal (for Stdio.File) class: Stdio.File->line_iterator.
 * Splits on lines, does only handle 8-bit characters.
 */
PIKECLASS file_line_iterator
{
  CVAR struct pike_string *buffer;
  CVAR struct pike_string *current;
  CVAR int offset;
  CVAR int index;
  CVAR struct svalue feed;


  static void fl_find_next(struct file_line_iterator_struct *ssi)
  {
    unsigned char *ptr, *eptr, *start;
    int start_off = ssi->offset;

    if (ssi->current)
    {
      free_string(ssi->current);
      ssi->current = NULL;
    }

    if (!ssi->buffer)
      return;

  again:
      start = ssi->buffer->str + start_off;
      ptr   = ssi->buffer->str + ssi->offset;
      eptr  = ssi->buffer->str + ssi->buffer->len;

      /* Loop until we find a '\n'. */
      while( ptr < eptr )
	if( *ptr != '\n'  )
	  ptr++;
	else
	{
	  ssi->current = make_shared_binary_string( start, ptr-start );
	  // skip the '\n'
	  ssi->offset =  ptr - ((unsigned char *)ssi->buffer->str) + 1;
	  ssi->index++;
	  return;
	}

      apply_svalue( &ssi->feed, 0 );
      if( Pike_sp[-1].type == PIKE_T_STRING &&
	  Pike_sp[-1].u.string->len )
      {
	push_string(make_shared_binary_string( ssi->buffer->str+start_off,
					       ssi->buffer->len-start_off));
	free_string( ssi->buffer );
	stack_swap();
	f_add( 2 );
	ssi->buffer = Pike_sp[-1].u.string;
	dmalloc_touch_svalue(Pike_sp-1);
	Pike_sp--;

	if( !ssi->buffer->size_shift )
	{
	  ssi->offset -= start_off;
	  start_off = 0;
	  goto again;
	}
	// Wide string.
      }
      else {
	// End of stream.
	pop_stack();
	if (start != ptr) {
	  ssi->current = make_shared_binary_string(start, ptr-start);
	  ssi->index++;
	}
      }
      free_string( ssi->buffer );
      ssi->buffer = NULL;
      return;
   }
  
  PIKEFUN string value()
    {
      if (THIS->current) {
	ref_push_string(THIS->current);
      } else {
	push_undefined();
      }
    }

  PIKEFUN int index()
    {
      if (!THIS->current) {
	push_undefined();
      }else{
	RETURN THIS->index;
      }
    }

  PIKEFUN object `+(int(0..) steps)
    {
      struct object *o=low_clone(file_line_iterator_program);
      struct file_line_iterator_struct *ssi;
      if (steps < 0)
	SIMPLE_ARG_ERROR ("Stdio.File.LineIterator.`+", 1,
			  "This iterator doesn't support going backwards.\n");
      (ssi = OBJ2_FILE_LINE_ITERATOR(o))[0]=*THIS;
      if (THIS->buffer) {
	add_ref(THIS->buffer);
      }
      if (THIS->current) {
	add_ref(THIS->current);
      }
      add_ref_svalue(&THIS->feed);
      while( steps-- )
	fl_find_next(ssi);
      RETURN o;
    }

  PIKEFUN object `+=(int(0..) steps)
    {
      if (steps < 0)
	SIMPLE_ARG_ERROR ("Stdio.File.LineIterator.`+=", 1,
			  "This iterator doesn't support going backwards.\n");
      while( steps-- )
	fl_find_next(THIS);
      REF_RETURN Pike_fp->current_object;
    }

  PIKEFUN int next()
    {
      fl_find_next(THIS);
      RETURN !!THIS->current;
    }

  PIKEFUN int `!()
    {
      RETURN !THIS->current;
    }

  PIKEFUN void create(function(:string)|void feed)
    {
      if (THIS->buffer) {
	Pike_error("iterators cannot be reused.\n");
      }
      assign_svalue( &THIS->feed, feed );
      apply_svalue( &THIS->feed, 0 );
      if( Pike_sp[-1].type != PIKE_T_STRING )
	Pike_error("Feed function returned illegal value\n");
      THIS->buffer = Pike_sp[-1].u.string;
      dmalloc_touch_svalue(Pike_sp-1);
      Pike_sp--;
      THIS->offset = 0;
      THIS->current = NULL;
      THIS->index = -1;
      fl_find_next(THIS);
    }
  
  INIT 
    {
      THIS->buffer = NULL;
      THIS->current = NULL;
      THIS->offset = 0;
      THIS->index = 0;
      THIS->feed.type = T_INT;
      THIS->feed.u.integer = 0;
    }

  EXIT
    {
      if (THIS->buffer) {
	free_string(THIS->buffer);
	THIS->buffer = NULL;
      }
      if (THIS->current) {
	free_string(THIS->current);
	THIS->current = NULL;
      }
      free_svalue(&THIS->feed);
      THIS->feed.type = T_INT;
      THIS->feed.u.integer = 0;
    }
  
  
}

/*! @module String
 */

/*! @class SplitIterator
 *! @inherit predef::Iterator
 *!
 *! An iterator that iterates over substrings of a string, separated
 *! by a character or several different characters.
 *!
 *! @note
 *!   Typically you don't need to explicitly use the SplitIterator.
 *!   Expressions like the following are automatically optimized into
 *!   using a SplitIterator.
 *!   @code
 *!     foreach(str/"\n", string line)
 *!       write("%s\n", line);
 *!   @endcode
 */
PIKECLASS string_split_iterator
{
  CVAR struct pike_string *buffer;
  CVAR struct pike_string *current;
  CVAR int offset;
  CVAR int index;
  CVAR p_wchar2 *split_set;
  CVAR int split_set_size;
  CVAR int flags;
  CVAR struct svalue feed;

#define SIMPLE_SKIP(THIS, SHIFT, OFF) 	 	\
  do {						\
    PIKE_CONCAT(p_wchar, SHIFT) *s = 		\
      PIKE_CONCAT(STR,SHIFT)(THIS->buffer);	\
    while((OFF < THIS->buffer->len) &&		\
          s[OFF] == THIS->split_set[0]) {	\
      OFF++;					\
    }						\
  } while(0)

#define SIMPLE_SKIP_CASE(THIS, SHIFT, OFF)	\
  case SHIFT:					\
    SIMPLE_SKIP(THIS, SHIFT, OFF);		\
    break

#define COMPLEX_SKIP(THIS, SHIFT, OFF)	 		\
  do {							\
    PIKE_CONCAT(p_wchar, SHIFT) *s = 			\
      PIKE_CONCAT(STR,SHIFT)(THIS->buffer);		\
    while(OFF < THIS->buffer->len) {			\
      int i;						\
      p_wchar2 ch = s[OFF];				\
      for (i=0; i < THIS->split_set_size; i++) {	\
	if (ch == THIS->split_set[i]) {			\
	  goto PIKE_CONCAT(continue_skip,SHIFT);	\
	}						\
      }							\
      break;						\
    PIKE_CONCAT(continue_skip,SHIFT):			\
      OFF++;						\
    }							\
  } while(0)
  
#define COMPLEX_SKIP_CASE(THIS, SHIFT, OFF)	\
  case SHIFT:					\
    COMPLEX_SKIP(THIS, SHIFT, OFF);		\
    break

#define SIMPLE_SCAN(THIS, SHIFT, OFF)		\
  do {						\
    PIKE_CONCAT(p_wchar, SHIFT) *s = 		\
      PIKE_CONCAT(STR,SHIFT)(THIS->buffer);	\
    while((OFF < THIS->buffer->len) &&		\
          s[OFF] != THIS->split_set[0]) {	\
      OFF++;					\
    }						\
  } while(0)

#define SIMPLE_SCAN_CASE(THIS, SHIFT, OFF)	\
  case SHIFT:					\
    SIMPLE_SCAN(THIS, SHIFT, OFF);		\
    break

#define COMPLEX_SCAN(THIS, SHIFT, OFF)				\
  do {								\
    PIKE_CONCAT(p_wchar, SHIFT) *s = 				\
      PIKE_CONCAT(STR,SHIFT)(THIS->buffer);			\
    while(OFF < THIS->buffer->len) {				\
      int i;							\
      p_wchar2 ch = s[OFF];					\
      for (i=0; i < THIS->split_set_size; i++) {		\
	if (ch == THIS->split_set[i]) {				\
	  goto PIKE_CONCAT(break_scan,SHIFT);			\
	}							\
      }								\
      OFF++;							\
    }								\
  PIKE_CONCAT(break_scan, SHIFT): ;/* gcc complains without ;*/ \
  } while(0)

#define COMPLEX_SCAN_CASE(THIS, SHIFT, OFF)	\
  case SHIFT:					\
    COMPLEX_SCAN(THIS, SHIFT, OFF);		\
    break

#define SIMPLE_SCAN_PUSH(THIS, SHIFT, OFF)			\
  do {								\
    PIKE_CONCAT(p_wchar, SHIFT) *s = 				\
      PIKE_CONCAT(STR,SHIFT)(THIS->buffer);			\
    while((OFF < THIS->buffer->len) &&				\
          s[OFF] != THIS->split_set[0]) {			\
      OFF++;							\
    }								\
    push_string(PIKE_CONCAT(make_shared_binary_string, SHIFT)	\
      (s+offset, OFF-offset));					\
  } while(0)

#define SIMPLE_SCAN_CASE_PUSH(THIS, SHIFT, OFF)	\
  case SHIFT:					\
    SIMPLE_SCAN_PUSH(THIS, SHIFT, OFF);		\
    break

#define COMPLEX_SCAN_PUSH(THIS, SHIFT, OFF)				\
  do {									\
    PIKE_CONCAT(p_wchar, SHIFT) *s = 					\
      PIKE_CONCAT(STR,SHIFT)(THIS->buffer);				\
    while(OFF < THIS->buffer->len) {					\
      int i;								\
      p_wchar2 ch = s[OFF];						\
      for (i=0; i < THIS->split_set_size; i++) {			\
	if (ch == THIS->split_set[i]) {					\
	  push_string(PIKE_CONCAT(make_shared_binary_string, SHIFT)	\
	    (s+offset, OFF-offset));					\
	  goto PIKE_CONCAT(break_scan,SHIFT);				\
	}								\
      }									\
      OFF++;								\
    }									\
    push_string(PIKE_CONCAT(make_shared_binary_string, SHIFT)		\
      (s+offset, OFF-offset));						\
  PIKE_CONCAT(break_scan, SHIFT):					\
    ;									\
  } while(0)

#define COMPLEX_SCAN_CASE_PUSH(THIS, SHIFT, OFF)	\
  case SHIFT:						\
    COMPLEX_SCAN_PUSH(THIS, SHIFT, OFF);		\
    break

#define NEW_SKIP_CASE(SHIFT, FLAGS)				\
  case SHIFT:							\
    if (FLAGS) {						\
      /* Skip empty */						\
      if (ssi->split_set_size == 1) {				\
	SIMPLE_SKIP(ssi, SHIFT, offset);			\
      } else {							\
        COMPLEX_SKIP(ssi, SHIFT, offset);			\
      }								\
    }								\
    if (offset >= ssi->buffer->len) {				\
      free_string(ssi->buffer);					\
      ssi->buffer = NULL;					\
      ssi->offset = 0;						\
      offset = 0;						\
      if (ssi->feed.type == T_INT) {				\
	if (!(FLAGS)) {						\
	  copy_shared_string(ssi->current, empty_pike_string);	\
	  ssi->index++;						\
	}							\
	return;							\
      } else {							\
	/* Attempt to fill the buffer with some more. */	\
	apply_svalue(&ssi->feed, 0);				\
	if ((Pike_sp[-1].type == T_STRING) &&			\
	    (Pike_sp[-1].u.string->len)) {			\
	  ssi->buffer = Pike_sp[-1].u.string;			\
          dmalloc_touch_svalue(Pike_sp-1);			\
	  Pike_sp--;						\
	  goto reskip_empty;					\
	}							\
	free_svalue(&ssi->feed);				\
	ssi->feed.type = T_INT;					\
	ssi->feed.u.integer = 0;				\
	pop_stack();						\
	if (!(FLAGS)) {						\
	  copy_shared_string(ssi->current, empty_pike_string);	\
	  ssi->index++;						\
	}							\
	return;							\
      }								\
    }								\
    ssi->index++;						\
    end = offset;						\
    goto PIKE_CONCAT(scan_more_,SHIFT)

#define NEW_SCAN_MORE_CASE(SHIFT)				\
  case SHIFT:							\
  PIKE_CONCAT(scan_more_,SHIFT):				\
    if (ssi->split_set_size == 1) {				\
      SIMPLE_SCAN_PUSH(ssi, SHIFT, end);			\
    } else {							\
      COMPLEX_SCAN_PUSH(ssi, SHIFT, end);			\
    }								\
    if ((end == ssi->buffer->len) &&				\
	(ssi->feed.type != T_INT)) {				\
      apply_svalue(&ssi->feed, 0);				\
      if ((Pike_sp[-1].type == T_STRING) &&			\
	  (Pike_sp[-1].u.string->len)) {			\
	f_add(2);						\
	if (Pike_sp[-1].type != T_STRING) {			\
	  Pike_error("Bad result from concatenation!\n");	\
	}							\
	free_string(ssi->buffer);				\
	ssi->buffer = Pike_sp[-1].u.string;			\
        dmalloc_touch_svalue(Pike_sp-1);			\
	Pike_sp--;						\
	end -= offset;						\
	offset = 0;						\
	goto scan_more;						\
      }								\
      pop_stack();	/* Pop the end of stream marker. */	\
      								\
      /* Make sure we don't call feed() any more. */		\
      free_svalue(&ssi->feed);					\
      ssi->feed.type = T_INT;					\
      ssi->feed.u.integer = 0;					\
    }								\
    ssi->offset = end+1;					\
    ssi->current = Pike_sp[-1].u.string;			\
    dmalloc_touch_svalue(Pike_sp-1);				\
    Pike_sp--;							\
    if (ssi->offset > ssi->buffer->len) {			\
      free_string(ssi->buffer);					\
      ssi->buffer = 0;						\
    }								\
    break
  
  static void find_next(struct string_split_iterator_struct *ssi)
    {
      int offset = ssi->offset;
      int end;
      if (ssi->current) {
	free_string(ssi->current);
      }
      ssi->current = NULL;
      if (!ssi->buffer) {
	return;
      }
    reskip_empty:
      switch(ssi->buffer->size_shift) {
	NEW_SKIP_CASE(0, ssi->flags);
	NEW_SKIP_CASE(1, ssi->flags);
	NEW_SKIP_CASE(2, ssi->flags);
      default:
	Pike_fatal("Unsupported size shift!\n");
      }
    scan_more:
      switch(ssi->buffer->size_shift)
      {
	NEW_SCAN_MORE_CASE(0);
	NEW_SCAN_MORE_CASE(1);
	NEW_SCAN_MORE_CASE(2);
      default:
	Pike_fatal("Unsupported size shift!\n");
      }
    }

  PIKEFUN string value()
    {
      if (THIS->current) {
	ref_push_string(THIS->current);
      } else {
	push_undefined();
      }
    }

  PIKEFUN int index()
    {
      if (!THIS->current) {
	push_undefined();
      }else{
	RETURN THIS->index;
      }
    }

  PIKEFUN object `+(int(0..) steps)
    {
      struct object *o=low_clone(string_split_iterator_program);
      int i;
      struct string_split_iterator_struct *ssi;
      if (steps < 0)
	SIMPLE_ARG_ERROR ("String.SplitIterator.`+", 1,
			  "This iterator doesn't support going backwards.\n");
      (ssi = OBJ2_STRING_SPLIT_ITERATOR(o))[0]=*THIS;
      if (THIS->buffer) {
	add_ref(THIS->buffer);
      }
      if (THIS->current) {
	add_ref(THIS->current);
      }
      add_ref_svalue(&THIS->feed);
      for (i=0; i < steps; i++) {
	find_next(ssi);
      }
      RETURN o;
    }

  PIKEFUN object `+=(int(0..) steps)
  {
    int i;
    if (steps < 0)
      SIMPLE_ARG_ERROR ("String.SplitIterator.`+=", 1,
			"This iterator doesn't support going backwards.\n");
    for(i = 0; i < steps; i++) {
      find_next(THIS);
    }
    REF_RETURN Pike_fp->current_object;
  }

  PIKEFUN int next()
    {
      find_next(THIS);
      RETURN !!THIS->current;
    }

  PIKEFUN int `!()
    {
      RETURN !THIS->current;
    }

  PIKEFUN int _sizeof()
  {
    INT_TYPE res = 0;
    if (THIS->buffer) {
      int i, off;
      ref_push_string(THIS->buffer);
      if (THIS->offset) {
	push_int(THIS->offset);
	push_int(THIS->buffer->len);
	o_range();
      }
      for (i = 1; THIS->feed.type != T_INT; i++) {
	apply_svalue(&THIS->feed, 0);
	if ((Pike_sp[-1].type != T_STRING) ||
	    (!Pike_sp[-1].u.string->len)) {
	  /* End of stream marker. */
	  pop_stack();
	  free_svalue(&THIS->feed);
	  THIS->feed.type = T_INT;
	  THIS->feed.u.integer = 0;
	  break;
	}
      }
      f_add(i);	/* Join the segments. */
      free_string(THIS->buffer);
      THIS->buffer = Pike_sp[-1].u.string;
      THIS->offset = 0;
      dmalloc_touch_svalue(Pike_sp-1);
      Pike_sp--;

      /* Perform the scan. */
      for (off=0; off < THIS->buffer->len; off++) {
	if (THIS->flags) {
	  if (THIS->split_set_size == 1) {
	    switch(THIS->buffer->size_shift) {
	      SIMPLE_SKIP_CASE(THIS, 0, off);
	      SIMPLE_SKIP_CASE(THIS, 1, off);
	      SIMPLE_SKIP_CASE(THIS, 2, off);
	    default:
	      Pike_fatal("Unsupported size shift!\n");
	    }
	  } else {
	    switch(THIS->buffer->size_shift) {
	      COMPLEX_SKIP_CASE(THIS, 0, off);
	      COMPLEX_SKIP_CASE(THIS, 1, off);
	      COMPLEX_SKIP_CASE(THIS, 2, off);
	    default:
	      Pike_fatal("Unsupported size shift!\n");
	    }	  
	  }
	  if (off >= THIS->buffer->len) {
	    break;
	  }
	}
	res++;
	if (THIS->split_set_size == 1) {
	  switch(THIS->buffer->size_shift) {
	    SIMPLE_SCAN_CASE(THIS, 0, off);
	    SIMPLE_SCAN_CASE(THIS, 1, off);
	    SIMPLE_SCAN_CASE(THIS, 2, off);
	  default:
	    Pike_fatal("Unsupported size shift!\n");
	  }
	} else {
	  switch(THIS->buffer->size_shift) {
	    COMPLEX_SCAN_CASE(THIS, 0, off);
	    COMPLEX_SCAN_CASE(THIS, 1, off);
	    COMPLEX_SCAN_CASE(THIS, 2, off);
	  default:
	    Pike_fatal("Unsupported size shift!\n");
	  }
	}
      }
      if ((!THIS->flags) && (off == THIS->buffer->len)) {
	/* Ends with an empty segment. */
	res++;
      }
    }
    if (THIS->current) {
      res++;
    }
    RETURN res;
  }

  /*! @decl void create(string buffer, int|array(int)|multiset(int) split_set,@
   *!                   int|void flags, function(:string)|void feed)
   *! @param buffer
   *!   The string to split.
   *! @param split_set
   *!   The character or characters to split on.
   *! @param flags
   *!   Skip empty elements if set.
   *! @param feed
   *!   Callback function that is called once the @[buffer] is used up
   *!   and the SplitIterator wants more data.
   */
  PIKEFUN void create(string buffer, int|array(int)|multiset(int) split_set,
		      int|void flags, function(:string)|void feed)
    {
      if (THIS->buffer) {
	Pike_error("String.split() iterators cannot be reused.\n");
      }
      if (split_set->type == T_INT) {
	THIS->split_set = (p_wchar2 *)xalloc(sizeof(p_wchar2));
	THIS->split_set[0] = split_set->u.integer;
	THIS->split_set_size = 1;
      } else {
	struct array *a;
	int i;
	if (split_set->type == T_ARRAY) {
	  a = split_set->u.array;
	} else if (split_set->type == T_MULTISET) {
	  a = multiset_indices (split_set->u.multiset);
	  push_array (a);
	} else {
	  SIMPLE_BAD_ARG_ERROR("String.split", 2,
			       "int|array(int)|multiset(int)");
	}
	if (!a->size) {
	  SIMPLE_BAD_ARG_ERROR("String.split", 2,
			       "int|array(int)|multiset(int)");
	}
	for (i=0; i < a->size; i++) {
	  if (a->item[i].type != T_INT) {
	    SIMPLE_BAD_ARG_ERROR("String.split", 2,
				 "int|array(int)|multiset(int)");
	  }
	}
	THIS->split_set = (p_wchar2 *)xalloc(a->size * sizeof(p_wchar2));
	for (i=0; i < a->size; i++) {
	  THIS->split_set[i] = a->item[i].u.integer;
	}
	THIS->split_set_size = a->size;
	if (split_set->type == T_MULTISET) pop_stack();
      }
      add_ref(THIS->buffer = buffer);
      if (args > 2) {
	if (flags->type == T_INT) {
	  THIS->flags = flags->u.integer;
	} else {
	  THIS->flags = 0;
	}
	if (args > 3) {
	  assign_svalue(&THIS->feed, feed);
	} else {
	  /* NB: THIS->feed has already been set to 0 by the init code. */
	}
      } else {
	THIS->flags = 0;
      }
      THIS->offset = 0;
      THIS->current = NULL;
      THIS->index = -1;
      find_next(THIS);
    }
  
  INIT 
    {
      THIS->buffer = NULL;
      THIS->current = NULL;
      THIS->offset = 0;
      THIS->index = 0;
      THIS->split_set = NULL;
      THIS->split_set_size = 0;
      THIS->flags = 0;
      THIS->feed.type = T_INT;
      THIS->feed.u.integer = 0;
    }

  EXIT
    {
      if (THIS->buffer) {
	free_string(THIS->buffer);
	THIS->buffer = NULL;
      }
      if (THIS->current) {
	free_string(THIS->current);
	THIS->current = NULL;
      }
      free(THIS->split_set);
      THIS->split_set = NULL;
      free_svalue(&THIS->feed);
      THIS->feed.type = T_INT;
      THIS->feed.u.integer = 0;
    }

  OPTIMIZE
    {
      if (CDR(n) && (CDR(n)->token == F_ARG_LIST) &&
	  CADR(n) && (CADR(n)->token == F_APPLY) &&
	  CAADR(n) && (CAADR(n)->token == F_CONSTANT) &&
	  (CAADR(n)->u.sval.type == T_FUNCTION) &&
	  (CAADR(n)->u.sval.subtype == FUNCTION_BUILTIN) &&
	  (CAADR(n)->u.sval.u.efun->function == f_replace)) {
	/* String.SplitIterator(replace(...),...) */
	node *repl_args = CDADR(n);
	node **str = my_get_arg(&repl_args, 0);
	node **from = my_get_arg(&repl_args, 1);
	node **to = my_get_arg(&repl_args, 2);

	if (str && from && to) {
	  /* String.SplitIterator(replace(str, from, to), ...) */

	  int num;

	  if (((*to)->token == F_APPLY) &&
	      CAR(*to) && (CAR(*to)->token == F_CONSTANT) &&
	      (CAR(*to)->u.sval.type == T_FUNCTION) &&
	      (CAR(*to)->u.sval.subtype == FUNCTION_BUILTIN) &&
	      (CAR(*to)->u.sval.u.efun->function == f_allocate) &&
	      CDR(*to) && (CDR(*to)->token == F_ARG_LIST) &&
	      CADR(*to) && (CADR(*to)->token == F_CONSTANT) &&
	      (CADR(*to)->u.sval.type == T_INT) &&
	      (num = CADR(*to)->u.sval.u.integer) &&
	      CDDR(*to) && (CDDR(*to)->token == F_CONSTANT) &&
	      (CDDR(*to)->u.sval.type == T_STRING) &&
	      (CDDR(*to)->u.sval.u.string->len == 1)) {
	    /* String.SplitIterator(replace(str, from, allocate(num, "x")),
	     *                      ...) */
	    int split_val = index_shared_string(CDDR(*to)->u.sval.u.string, 0);

	    if (CDDR(n) &&
		(((CDDR(n)->token == F_CONSTANT) &&
		  (CDDR(n)->u.sval.type == T_INT) &&
		  (CDDR(n)->u.sval.u.integer == split_val)) ||
		 ((CDDR(n)->token == F_ARG_LIST) &&
		  CADDR(n) && (CADDR(n)->token == F_CONSTANT) &&
		  (CADDR(n)->u.sval.type == T_INT) &&
		  (CADDR(n)->u.sval.u.integer == split_val)))) {
	      /* String.SplitIterator(replace(str, from, allocate(n, "x")),
	       *                      'x', ...)
	       */
	      struct array *split = NULL;
	      node *res = NULL;

	      switch((*from)->token) {
	      case F_CONSTANT:
		if (((*from)->u.sval.type == T_ARRAY) &&
		    ((*from)->u.sval.u.array->size == num)) {
		  int i;
		  for (i=0; i < num; i++) {
		    if (((*from)->u.sval.u.array->item[i].type != T_STRING) ||
			((*from)->u.sval.u.array->item[i].u.string->len != 1)) {
		      return NULL;
		    }
		  }
		  split = allocate_array(num+1);
		  split->item[0].u.integer = split_val;
		  for (i=0; i < num; i++) {
		    split->item[i+1].u.integer =
		      index_shared_string((*from)->u.sval.u.array->
					  item[i].u.string, 0);
		  }
		  split->type_field = BIT_INT;
		}
		break;
	      case F_APPLY:
		if (CAR(*from) && (CAR(*from)->token == F_CONSTANT) &&
		    (CAR(*from)->u.sval.type == T_FUNCTION) &&
		    (CAR(*from)->u.sval.subtype == FUNCTION_BUILTIN)) {
		  if (CAR(*from)->u.sval.u.efun->function == f_allocate) {
		    /* FIXME: Not likely */
		  } else if (CAR(*from)->u.sval.u.efun->function ==
			     debug_f_aggregate) {
		    node *tmp = CDR(*from);
		    int i;
		    for (i = 0; tmp && (tmp->token == F_ARG_LIST);
			 tmp = CDR(tmp)) {
		      if (!CAR(tmp)) continue;
		      if ((CAR(tmp)->token != F_CONSTANT) || 
			  (CAR(tmp)->u.sval.type != T_STRING) ||
			  (CAR(tmp)->u.sval.u.string->len != 1)) {
			return NULL;
		      }
		      i++;
		    }
		    if (i != num) {
		      return NULL;
		    }
		    split = allocate_array(num+1);
		    split->item[0].u.integer = split_val;
		    tmp = CDR(*from);
		    for (i = 1; tmp && (tmp->token == F_ARG_LIST);
			 tmp = CDR(tmp)) {
		      if (!CAR(tmp)) continue;
		      split->item[i].u.integer =
			index_shared_string(CAR(tmp)->u.sval.u.string, 0);
		      i++;
		    }
		    split->type_field = BIT_INT;
		  }
		} else {
		  return NULL;
		}
		break;
	      default:
		return NULL;
	      }
	      if (!split) {
		return NULL;
	      }
	      push_array(split);	/* Simplify error-handling... */

	      /* Create the result...
	       *
	       * String.SplitIterator(str, split, ...)
	       */
	      if (CDDR(n)->token == F_ARG_LIST) {
		ADD_NODE_REF2(CAR(n),
		ADD_NODE_REF2(*str,
		ADD_NODE_REF2(CDDDR(n),
		  res =
		    mkapplynode(CAR(n),
			        mknode(F_ARG_LIST, *str,
				       mknode(F_ARG_LIST,
					      mkconstantsvaluenode(Pike_sp-1),
					      CDDDR(n))));
		)));
	      } else {
		ADD_NODE_REF2(CAR(n),
		ADD_NODE_REF2(*str,
		  res =
		    mkapplynode(CAR(n),
			        mknode(F_ARG_LIST, *str,
				       mkconstantsvaluenode(Pike_sp-1)));
		));
	      }
	      pop_stack();
	      return res;
	    }
	  }
	}
      }
      return NULL;
    }
};

/*! @endclass
 */

/*! @endmodule
 */

/*! @decl Iterator get_iterator (object|array|mapping|multiset|string data)
 *!
 *! Creates and returns a canonical iterator for @[data].
 *!
 *! @returns
 *!   @mixed data
 *!     @type object
 *!       If @[data] is an object with @[lfun::_get_iterator] defined then
 *!       it's called in it to create the iterator.
 *!   
 *!       If @[data] is an object that lacks @[lfun::_get_iterator] then
 *!       it's assumed to already be an iterator object, and is simply
 *!       returned.
 *!     @type array
 *!       If @[data] is an array, an @[Array.Iterator] object will be
 *!       returned.
 *!     @type mapping
 *!       If @[data] is a mapping, a @[Mapping.Iterator] object will be
 *!       returned
 *!     @type multiset
 *!       If @[data] is a multiset, a @[Multiset.Iterator] object will be
 *!       returned
 *!     @type string
 *!       If @[data] is a string, a @[String.Iterator] object will be
 *!       returned
 *!   @endmixed
 *!
 *! @note
 *!   This function is used by @[foreach] to get an iterator for an
 *!   object.
 *!
 *! @seealso
 *!   @[Iterator], @[lfun::_get_iterator]
 */
PIKEFUN object(Iterator) get_iterator(object|array|mapping|multiset|string data)
  efun;
{
  switch(data->type)
  {
    case PIKE_T_STRING:
      push_object(clone_object(string_iterator_program, 1));
      return;

    case PIKE_T_MAPPING:
      push_object(clone_object(mapping_iterator_program,1));
      return;

    case PIKE_T_MULTISET:
      push_object(clone_object(multiset_iterator_program, 1));
      return;

    case PIKE_T_ARRAY:
      push_object(clone_object(array_iterator_program, 1));
      return;


    case PIKE_T_OBJECT: {
      int fun;

      if(!data->u.object->prog)
	SIMPLE_ARG_ERROR ("get_iterator", 1, "Got a destructed object.\n");

      fun = FIND_LFUN(data->u.object->prog, LFUN__GET_ITERATOR);
      if (fun != -1)
      {
	apply_low (data->u.object, fun, 0);
	if (sp[-1].type != T_OBJECT) {
	  /* FIXME: Ought to include what we got in the error message. */
	  pop_stack();
	  SIMPLE_ARG_ERROR ("get_iterator", 1,
			    "_get_iterator() didn't return an object.\n");
	}
	stack_pop_keep_top();
	return;
      }

      /* Assume it already is an iterator... */
      return;
    }

    default:
      SIMPLE_ARG_TYPE_ERROR("get_iterator", 1, "multiset|array|string|mapping|object");
  }
}

/* sp[-4] = index; sp[-2] = value */
int foreach_iterate(struct object *o, int do_step)
{
  struct program *prog = o->prog;
  int fun;

  if(!prog)
    Pike_error("foreach on destructed iterator.\n");

  if(prog->flags & PROGRAM_HAS_C_METHODS)
  {
    if(prog == mapping_iterator_program)
    {
      struct mapping_iterator_struct *i=OBJ2_MAPPING_ITERATOR(o);

      if (!i->current) return 0;
      if (do_step) {
	mi_step (i);
	if (!i->current) return 0;
      }

      if(Pike_sp[-4].type != T_INT)
	assign_lvalue(Pike_sp-4, & i->current->ind);
	
      if(Pike_sp[-2].type != T_INT)
	assign_lvalue(Pike_sp-2, & i->current->val);

      return 1;
    }

    else if(prog == string_split_iterator_program)
    {
      struct string_split_iterator_struct *i=OBJ2_STRING_SPLIT_ITERATOR(o);

      if (!i->current) return 0;
      if (do_step) {
	find_next (i);
	if (!i->current) return 0;
      }

      if(Pike_sp[-4].type != T_INT)
      {
	/* Black Magic... */
	push_int(i->index);
	Pike_sp--;
	assign_lvalue(Pike_sp-4, Pike_sp);
      }

      if(Pike_sp[-2].type != T_INT)
      {
	/* Black Magic... */
	push_string(i->current);
	dmalloc_touch_svalue(Pike_sp-1);
	Pike_sp--;
	assign_lvalue(Pike_sp-2, Pike_sp);
      }

      return 1;
    }

    else if(prog == file_line_iterator_program)
    {
      struct file_line_iterator_struct *i=OBJ2_FILE_LINE_ITERATOR(o);

      if (!i->current) return 0;
      if (do_step) {
	fl_find_next (i);
	if (!i->current) return 0;
      }

      if(Pike_sp[-4].type != T_INT)
      {
	/* Black Magic... */
	push_int(i->index);
	Pike_sp--;
	assign_lvalue(Pike_sp-4, Pike_sp);
      }

      if(Pike_sp[-2].type != T_INT)
      {
	/* Black Magic... */
	push_string(i->current);
	dmalloc_touch_svalue(Pike_sp-1);
	Pike_sp--;
	assign_lvalue(Pike_sp-2, Pike_sp);
      }

      return 1;
    }

    else if(prog == array_iterator_program)
    {
      struct array_iterator_struct *i=OBJ2_ARRAY_ITERATOR(o);

      if (i->pos < 0 || i->pos >= i->a->size) return 0;
      if (do_step)
	if (++i->pos == i->a->size) return 0;

      if(Pike_sp[-4].type != T_INT)
      {
	push_int(i->pos);
	assign_lvalue(Pike_sp-5, Pike_sp-1);
	pop_stack();
      }

      if(Pike_sp[-2].type != T_INT)
	assign_lvalue(Pike_sp-2, i->a->item + i->pos);

      return 1;
    }

    else if(prog == multiset_iterator_program)
    {
      struct multiset_iterator_struct *i=OBJ2_MULTISET_ITERATOR(o);

      struct svalue ind;

      if (i->nodepos < 0) return 0;
      if (do_step) {
	i->nodepos = multiset_next (i->l, i->nodepos);
	if (i->nodepos < 0) {
	  sub_msnode_ref (i->l);
	  return 0;
	}
      }

      if (Pike_sp[-4].type != T_INT)
	assign_lvalue (Pike_sp - 4, use_multiset_index (i->l, i->nodepos, ind));
      if (Pike_sp[-2].type != T_INT)
	assign_lvalue (Pike_sp - 2, get_multiset_value (i->l, i->nodepos));

      return 1;
    }

    else if(prog == string_iterator_program)
    {
      struct string_iterator_struct *i=OBJ2_STRING_ITERATOR(o);

      if (i->pos < 0 || i->pos >= i->s->len) return 0;
      if (do_step)
	if (++i->pos == i->s->len) return 0;

      if(Pike_sp[-4].type != T_INT)
      {
	push_int(i->pos);
	assign_lvalue(Pike_sp-5, Pike_sp-1);
	pop_stack();
      }

      if(Pike_sp[-2].type != T_INT)
      {
	push_int(index_shared_string(i->s, i->pos));
	assign_lvalue(Pike_sp-3, Pike_sp-1);
	pop_stack();
      }

      return 1;
    }
  }

  /* Generic iteration */

  if (do_step) {
    fun = FIND_LFUN (prog, LFUN_ADD_EQ);
    if (fun < 0) Pike_error ("Iterator object lacks `+=.\n");
    push_int(1);
    apply_low(o, fun, 1);
    pop_stack();
  }

#if 0
  /* We should be able to save calls to `! this way, but there are
   * iterators where index() and value() don't return UNDEFINED as
   * stipulated by the interface. */

  fun = -1;

  if(Pike_sp[-4].type != T_INT)
  {
    fun = find_identifier ("index", prog);
    if (fun < 0) Pike_error ("Iterator object lacks index().\n");
    apply_low(o, fun, 0);
    if (IS_UNDEFINED (Pike_sp - 1)) {
      Pike_sp--;
      return 0;
    }
    assign_lvalue(Pike_sp-5,Pike_sp-1);
    pop_stack();
  }

  if(Pike_sp[-2].type != T_INT)
  {
    fun = find_identifier ("value", prog);
    if (fun < 0) Pike_error ("Iterator object lacks value().\n");
    apply_low(o, fun, 0);
    if (IS_UNDEFINED (Pike_sp - 1)) {
      Pike_sp--;
      return 0;
    }
    assign_lvalue(Pike_sp-3,Pike_sp-1);
    pop_stack();
  }

  if (fun >= 0)
    /* index() and/or value() has returned a value so we know we can
     * iterate without calling `!. */
    return 1;
  else {
    int res;
    fun = FIND_LFUN (prog, LFUN_NOT);
    if (fun < 0) Pike_error ("Iterator object lacks `!.\n");
    apply_low(o, fun, 0);
    res = UNSAFE_IS_ZERO(Pike_sp-1);
    pop_stack();
    return res;
  }

#else

  fun = FIND_LFUN (o->prog, LFUN_NOT);
  if (fun < 0) Pike_error ("Iterator object lacks `!.\n");
  apply_low(o, fun, 0);
  if(UNSAFE_IS_ZERO(Pike_sp-1))
  {
    pop_stack();

    if(Pike_sp[-4].type != T_INT)
    {
      fun = find_identifier ("index", o->prog);
      if (fun < 0) Pike_error ("Iterator object lacks index().\n");
      apply_low(o, fun, 0);
      assign_lvalue(Pike_sp-5,Pike_sp-1);
      pop_stack();
    }

    if(Pike_sp[-2].type != T_INT)
    {
      fun = find_identifier ("value", o->prog);
      if (fun < 0) Pike_error ("Iterator object lacks value().\n");
      apply_low(o, fun, 0);
      assign_lvalue(Pike_sp-3,Pike_sp-1);
      pop_stack();
    }

    return 1;
  }else{
    pop_stack();
    return 0;
  }

#endif
}


void init_iterators(void)
{
  INIT;
  add_global_program ("Iterator", Iterator_program);
}

void exit_iterators(void)
{
  EXIT
}