text: /* Simple iterators for GDB/Scheme.
  
     Copyright (C) 2014 Free Software Foundation, Inc.
  
     This file is part of GDB.
  
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
     the Free Software Foundation; either version 3 of the License, or
     (at your option) any later version.
  
     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.
  
     You should have received a copy of the GNU General Public License
     along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  
  /* See README file in this directory for implementation notes, coding
     conventions, et.al.  */
  
  /* These are *simple* iterators, used to implement iterating over a collection
     of objects.  They are implemented as a smob containing three objects:
  
     1) the object being iterated over,
     2) an object to record the progress of the iteration,
     3) a procedure of one argument (the iterator object) that returns the next
        object in the iteration or a pre-determined end marker.
  
     Simple example:
  
     (define-public (make-list-iterator l end-marker)
       "Return a <gdb:iterator> object for a list."
       (let ((next! (lambda (iter)
  		    (let ((l (iterator-progress iter)))
  		      (if (eq? l '())
  		          end-marker
  		          (begin
  			    (set-iterator-progress! iter (cdr l))
  			    (car l)))))))
         (make-iterator l l next!)))
  
     (define l '(1 2))
     (define i (make-list-iterator l #:eoi))
     (iterator-next! i) -> 1
     (iterator-next! i) -> 2
     (iterator-next! i) -> #:eoi
  
     There is SRFI 41, Streams.  We might support that too eventually (not with
     this interface of course).  */
  
  #include "defs.h"
  #include "guile-internal.h"
  
  /* A smob for iterating over something.
     Typically this is used when computing a list of everything is
     too expensive.
     The typedef for this struct is in guile-internal.h.  */
  
  struct _iterator_smob
  {
    /* This always appears first.  */
    gdb_smob base;
  
    /* The object being iterated over.  */
    SCM object;
  
    /* An arbitrary object describing the progress of the iteration.
       This is used by next_x to track progress.  */
    SCM progress;
  
    /* A procedure of one argument, the iterator.
       It returns the next object in the iteration.
       How to signal "end of iteration" is up to next_x.  */
    SCM next_x;
  };
  
  static const char iterator_smob_name[] = "gdb:iterator";
  
  /* The tag Guile knows the iterator smob by.  */
  static scm_t_bits iterator_smob_tag;
  
  /* A unique-enough marker to denote "end of iteration".  */
  static SCM end_of_iteration;
  
  const char *
  itscm_iterator_smob_name (void)
  {
    return iterator_smob_name;
  }
  
  SCM
  itscm_iterator_smob_object (iterator_smob *i_smob)
  {
    return i_smob->object;
  }
  
  SCM
  itscm_iterator_smob_progress (iterator_smob *i_smob)
  {
    return i_smob->progress;
  }
  
  void
  itscm_set_iterator_smob_progress_x (iterator_smob *i_smob, SCM progress)
  {
    i_smob->progress = progress;
  }
  
  /* Administrivia for iterator smobs.  */
  
  /* The smob "print" function for <gdb:iterator>.  */
  
  static int
  itscm_print_iterator_smob (SCM self, SCM port, scm_print_state *pstate)
  {
    iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self);
  
    gdbscm_printf (port, "#<%s ", iterator_smob_name);
    scm_write (i_smob->object, port);
    scm_puts (" ", port);
    scm_write (i_smob->progress, port);
    scm_puts (" ", port);
    scm_write (i_smob->next_x, port);
    scm_puts (">", port);
  
    scm_remember_upto_here_1 (self);
  
    /* Non-zero means success.  */
    return 1;
  }
  
  /* Low level routine to make a <gdb:iterator> object.
     Caller must verify correctness of arguments.
     No exceptions are thrown.  */
  
  static SCM
  itscm_make_iterator_smob (SCM object, SCM progress, SCM next)
  {
    iterator_smob *i_smob = (iterator_smob *)
      scm_gc_malloc (sizeof (iterator_smob), iterator_smob_name);
    SCM i_scm;
  
    i_smob->object = object;
    i_smob->progress = progress;
    i_smob->next_x = next;
    i_scm = scm_new_smob (iterator_smob_tag, (scm_t_bits) i_smob);
    gdbscm_init_gsmob (&i_smob->base);
  
    return i_scm;
  }
  
  /* (make-iterator object object procedure) -> <gdb:iterator> */
  
  SCM
  gdbscm_make_iterator (SCM object, SCM progress, SCM next)
  {
    SCM i_scm;
  
    SCM_ASSERT_TYPE (gdbscm_is_procedure (next), next, SCM_ARG3, FUNC_NAME,
  		   _("procedure"));
  
    i_scm = itscm_make_iterator_smob (object, progress, next);
  
    return i_scm;
  }
  
  /* Return non-zero if SCM is a <gdb:iterator> object.  */
  
  int
  itscm_is_iterator (SCM scm)
  {
    return SCM_SMOB_PREDICATE (iterator_smob_tag, scm);
  }
  
  /* (iterator? object) -> boolean */
  
  static SCM
  gdbscm_iterator_p (SCM scm)
  {
    return scm_from_bool (itscm_is_iterator (scm));
  }
  
  /* (end-of-iteration) -> an "end-of-iteration" marker
     We rely on this not being used as a data result of an iterator.  */
  
  SCM
  gdbscm_end_of_iteration (void)
  {
    return end_of_iteration;
  }
  
  /* Return non-zero if OBJ is the end-of-iteration marker.  */
  
  int
  itscm_is_end_of_iteration (SCM obj)
  {
    return scm_is_eq (obj, end_of_iteration);
  }
  
  /* (end-of-iteration? obj) -> boolean */
  
  static SCM
  gdbscm_end_of_iteration_p (SCM obj)
  {
    return scm_from_bool (itscm_is_end_of_iteration (obj));
  }
  
  /* Call the next! method on ITER, which must be a <gdb:iterator> object.
     Returns a <gdb:exception> object if an exception is thrown.
     OK_EXCPS is passed to gdbscm_safe_call_1.  */
  
  SCM
  itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps)
  {
    iterator_smob *i_smob;
  
    gdb_assert (itscm_is_iterator (iter));
  
    i_smob = (iterator_smob *) SCM_SMOB_DATA (iter);
    return gdbscm_safe_call_1 (i_smob->next_x, iter, ok_excps);
  }
  
  /* Iterator methods.  */
  
  /* Returns the <gdb:iterator> smob in SELF.
     Throws an exception if SELF is not an iterator smob.  */
  
  SCM
  itscm_get_iterator_arg_unsafe (SCM self, int arg_pos, const char *func_name)
  {
    SCM_ASSERT_TYPE (itscm_is_iterator (self), self, arg_pos, func_name,
  		   iterator_smob_name);
  
    return self;
  }
  
  /* (iterator-object <gdb:iterator>) -> object */
  
  static SCM
  gdbscm_iterator_object (SCM self)
  {
    SCM i_scm;
    iterator_smob *i_smob;
  
    i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
    i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
  
    return i_smob->object;
  }
  
  /* (iterator-progress <gdb:iterator>) -> object */
  
  static SCM
  gdbscm_iterator_progress (SCM self)
  {
    SCM i_scm;
    iterator_smob *i_smob;
  
    i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
    i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
  
    return i_smob->progress;
  }
  
  /* (set-iterator-progress! <gdb:iterator> object) -> unspecified */
  
  static SCM
  gdbscm_set_iterator_progress_x (SCM self, SCM value)
  {
    SCM i_scm;
    iterator_smob *i_smob;
  
    i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
    i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
  
    i_smob->progress = value;
    return SCM_UNSPECIFIED;
  }
  
  /* (iterator-next! <gdb:iterator>) -> object
     The result is the next value in the iteration or some "end" marker.
     It is up to each iterator's next! function to specify what its end
     marker is.  */
  
  static SCM
  gdbscm_iterator_next_x (SCM self)
  {
    SCM i_scm;
    iterator_smob *i_smob;
  
    i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
    i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
    /* We leave type-checking of the procedure to gdbscm_safe_call_1.  */
  
    return gdbscm_safe_call_1 (i_smob->next_x, self, NULL);
  }
  
  /* Initialize the Scheme iterator code.  */
  
  static const scheme_function iterator_functions[] =
  {
    { "make-iterator", 3, 0, 0, gdbscm_make_iterator,
      "\
  Create a <gdb:iterator> object.\n\
  \n\
    Arguments: object progress next!\n\
      object:   The object to iterate over.\n\
      progress: An object to use to track progress of the iteration.\n\
      next!:    A procedure of one argument, the iterator.\n\
        Returns the next element in the iteration or an implementation-chosen\n\
        value to signify iteration is complete.\n\
        By convention end-of-iteration should be marked with (end-of-iteration)\n\
        from module (gdb iterator)." },
  
    { "iterator?", 1, 0, 0, gdbscm_iterator_p,
      "\
  Return #t if the object is a <gdb:iterator> object." },
  
    { "iterator-object", 1, 0, 0, gdbscm_iterator_object,
      "\
  Return the object being iterated over." },
  
    { "iterator-progress", 1, 0, 0, gdbscm_iterator_progress,
      "\
  Return the progress object of the iterator." },
  
    { "set-iterator-progress!", 2, 0, 0, gdbscm_set_iterator_progress_x,
      "\
  Set the progress object of the iterator." },
  
    { "iterator-next!", 1, 0, 0, gdbscm_iterator_next_x,
      "\
  Invoke the next! procedure of the iterator and return its result." },
  
    { "end-of-iteration", 0, 0, 0, gdbscm_end_of_iteration,
      "\
  Return the end-of-iteration marker." },
  
    { "end-of-iteration?", 1, 0, 0, gdbscm_end_of_iteration_p,
      "\
  Return #t if the object is the end-of-iteration marker." },
  
    END_FUNCTIONS
  };
  
  void
  gdbscm_initialize_iterators (void)
  {
    iterator_smob_tag = gdbscm_make_smob_type (iterator_smob_name,
  					     sizeof (iterator_smob));
    scm_set_smob_print (iterator_smob_tag, itscm_print_iterator_smob);
  
    gdbscm_define_functions (iterator_functions, 1);
  
    /* We can make this more unique if it's necessary,
       but this is good enough for now.  */
    end_of_iteration = scm_from_latin1_keyword ("end-of-iteration");
  }
  