1/* Simple iterators for GDB/Scheme.
2
3   Copyright (C) 2014-2023 Free Software Foundation, Inc.
4
5   This file is part of GDB.
6
7   This program is free software; you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation; either version 3 of the License, or
10   (at your option) any later version.
11
12   This program is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16
17   You should have received a copy of the GNU General Public License
18   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19
20/* See README file in this directory for implementation notes, coding
21   conventions, et.al.  */
22
23/* These are *simple* iterators, used to implement iterating over a collection
24   of objects.  They are implemented as a smob containing three objects:
25
26   1) the object being iterated over,
27   2) an object to record the progress of the iteration,
28   3) a procedure of one argument (the iterator object) that returns the next
29      object in the iteration or a pre-determined end marker.
30
31   Simple example:
32
33   (define-public (make-list-iterator l end-marker)
34     "Return a <gdb:iterator> object for a list."
35     (let ((next! (lambda (iter)
36		    (let ((l (iterator-progress iter)))
37		      (if (eq? l '())
38			  end-marker
39			  (begin
40			    (set-iterator-progress! iter (cdr l))
41			    (car l)))))))
42       (make-iterator l l next!)))
43
44   (define l '(1 2))
45   (define i (make-list-iterator l #:eoi))
46   (iterator-next! i) -> 1
47   (iterator-next! i) -> 2
48   (iterator-next! i) -> #:eoi
49
50   There is SRFI 41, Streams.  We might support that too eventually (not with
51   this interface of course).  */
52
53#include "defs.h"
54#include "guile-internal.h"
55
56/* A smob for iterating over something.
57   Typically this is used when computing a list of everything is
58   too expensive.  */
59
60struct iterator_smob
61{
62  /* This always appears first.  */
63  gdb_smob base;
64
65  /* The object being iterated over.  */
66  SCM object;
67
68  /* An arbitrary object describing the progress of the iteration.
69     This is used by next_x to track progress.  */
70  SCM progress;
71
72  /* A procedure of one argument, the iterator.
73     It returns the next object in the iteration.
74     How to signal "end of iteration" is up to next_x.  */
75  SCM next_x;
76};
77
78static const char iterator_smob_name[] = "gdb:iterator";
79
80/* The tag Guile knows the iterator smob by.  */
81static scm_t_bits iterator_smob_tag;
82
83/* A unique-enough marker to denote "end of iteration".  */
84static SCM end_of_iteration;
85
86const char *
87itscm_iterator_smob_name (void)
88{
89  return iterator_smob_name;
90}
91
92SCM
93itscm_iterator_smob_object (iterator_smob *i_smob)
94{
95  return i_smob->object;
96}
97
98SCM
99itscm_iterator_smob_progress (iterator_smob *i_smob)
100{
101  return i_smob->progress;
102}
103
104void
105itscm_set_iterator_smob_progress_x (iterator_smob *i_smob, SCM progress)
106{
107  i_smob->progress = progress;
108}
109
110/* Administrivia for iterator smobs.  */
111
112/* The smob "print" function for <gdb:iterator>.  */
113
114static int
115itscm_print_iterator_smob (SCM self, SCM port, scm_print_state *pstate)
116{
117  iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self);
118
119  gdbscm_printf (port, "#<%s ", iterator_smob_name);
120  scm_write (i_smob->object, port);
121  scm_puts (" ", port);
122  scm_write (i_smob->progress, port);
123  scm_puts (" ", port);
124  scm_write (i_smob->next_x, port);
125  scm_puts (">", port);
126
127  scm_remember_upto_here_1 (self);
128
129  /* Non-zero means success.  */
130  return 1;
131}
132
133/* Low level routine to make a <gdb:iterator> object.
134   Caller must verify correctness of arguments.
135   No exceptions are thrown.  */
136
137static SCM
138itscm_make_iterator_smob (SCM object, SCM progress, SCM next)
139{
140  iterator_smob *i_smob = (iterator_smob *)
141    scm_gc_malloc (sizeof (iterator_smob), iterator_smob_name);
142  SCM i_scm;
143
144  i_smob->object = object;
145  i_smob->progress = progress;
146  i_smob->next_x = next;
147  i_scm = scm_new_smob (iterator_smob_tag, (scm_t_bits) i_smob);
148  gdbscm_init_gsmob (&i_smob->base);
149
150  return i_scm;
151}
152
153/* (make-iterator object object procedure) -> <gdb:iterator> */
154
155SCM
156gdbscm_make_iterator (SCM object, SCM progress, SCM next)
157{
158  SCM i_scm;
159
160  SCM_ASSERT_TYPE (gdbscm_is_procedure (next), next, SCM_ARG3, FUNC_NAME,
161		   _("procedure"));
162
163  i_scm = itscm_make_iterator_smob (object, progress, next);
164
165  return i_scm;
166}
167
168/* Return non-zero if SCM is a <gdb:iterator> object.  */
169
170int
171itscm_is_iterator (SCM scm)
172{
173  return SCM_SMOB_PREDICATE (iterator_smob_tag, scm);
174}
175
176/* (iterator? object) -> boolean */
177
178static SCM
179gdbscm_iterator_p (SCM scm)
180{
181  return scm_from_bool (itscm_is_iterator (scm));
182}
183
184/* (end-of-iteration) -> an "end-of-iteration" marker
185   We rely on this not being used as a data result of an iterator.  */
186
187SCM
188gdbscm_end_of_iteration (void)
189{
190  return end_of_iteration;
191}
192
193/* Return non-zero if OBJ is the end-of-iteration marker.  */
194
195int
196itscm_is_end_of_iteration (SCM obj)
197{
198  return scm_is_eq (obj, end_of_iteration);
199}
200
201/* (end-of-iteration? obj) -> boolean */
202
203static SCM
204gdbscm_end_of_iteration_p (SCM obj)
205{
206  return scm_from_bool (itscm_is_end_of_iteration (obj));
207}
208
209/* Call the next! method on ITER, which must be a <gdb:iterator> object.
210   Returns a <gdb:exception> object if an exception is thrown.
211   OK_EXCPS is passed to gdbscm_safe_call_1.  */
212
213SCM
214itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps)
215{
216  iterator_smob *i_smob;
217
218  gdb_assert (itscm_is_iterator (iter));
219
220  i_smob = (iterator_smob *) SCM_SMOB_DATA (iter);
221  return gdbscm_safe_call_1 (i_smob->next_x, iter, ok_excps);
222}
223
224/* Iterator methods.  */
225
226/* Returns the <gdb:iterator> smob in SELF.
227   Throws an exception if SELF is not an iterator smob.  */
228
229SCM
230itscm_get_iterator_arg_unsafe (SCM self, int arg_pos, const char *func_name)
231{
232  SCM_ASSERT_TYPE (itscm_is_iterator (self), self, arg_pos, func_name,
233		   iterator_smob_name);
234
235  return self;
236}
237
238/* (iterator-object <gdb:iterator>) -> object */
239
240static SCM
241gdbscm_iterator_object (SCM self)
242{
243  SCM i_scm;
244  iterator_smob *i_smob;
245
246  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
247  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
248
249  return i_smob->object;
250}
251
252/* (iterator-progress <gdb:iterator>) -> object */
253
254static SCM
255gdbscm_iterator_progress (SCM self)
256{
257  SCM i_scm;
258  iterator_smob *i_smob;
259
260  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
261  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
262
263  return i_smob->progress;
264}
265
266/* (set-iterator-progress! <gdb:iterator> object) -> unspecified */
267
268static SCM
269gdbscm_set_iterator_progress_x (SCM self, SCM value)
270{
271  SCM i_scm;
272  iterator_smob *i_smob;
273
274  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
275  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
276
277  i_smob->progress = value;
278  return SCM_UNSPECIFIED;
279}
280
281/* (iterator-next! <gdb:iterator>) -> object
282   The result is the next value in the iteration or some "end" marker.
283   It is up to each iterator's next! function to specify what its end
284   marker is.  */
285
286static SCM
287gdbscm_iterator_next_x (SCM self)
288{
289  SCM i_scm;
290  iterator_smob *i_smob;
291
292  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
293  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
294  /* We leave type-checking of the procedure to gdbscm_safe_call_1.  */
295
296  return gdbscm_safe_call_1 (i_smob->next_x, self, NULL);
297}
298
299/* Initialize the Scheme iterator code.  */
300
301static const scheme_function iterator_functions[] =
302{
303  { "make-iterator", 3, 0, 0, as_a_scm_t_subr (gdbscm_make_iterator),
304    "\
305Create a <gdb:iterator> object.\n\
306\n\
307  Arguments: object progress next!\n\
308    object:   The object to iterate over.\n\
309    progress: An object to use to track progress of the iteration.\n\
310    next!:    A procedure of one argument, the iterator.\n\
311      Returns the next element in the iteration or an implementation-chosen\n\
312      value to signify iteration is complete.\n\
313      By convention end-of-iteration should be marked with (end-of-iteration)\n\
314      from module (gdb iterator)." },
315
316  { "iterator?", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_p),
317    "\
318Return #t if the object is a <gdb:iterator> object." },
319
320  { "iterator-object", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_object),
321    "\
322Return the object being iterated over." },
323
324  { "iterator-progress", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_progress),
325    "\
326Return the progress object of the iterator." },
327
328  { "set-iterator-progress!", 2, 0, 0,
329    as_a_scm_t_subr (gdbscm_set_iterator_progress_x),
330    "\
331Set the progress object of the iterator." },
332
333  { "iterator-next!", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_next_x),
334    "\
335Invoke the next! procedure of the iterator and return its result." },
336
337  { "end-of-iteration", 0, 0, 0, as_a_scm_t_subr (gdbscm_end_of_iteration),
338    "\
339Return the end-of-iteration marker." },
340
341  { "end-of-iteration?", 1, 0, 0, as_a_scm_t_subr (gdbscm_end_of_iteration_p),
342    "\
343Return #t if the object is the end-of-iteration marker." },
344
345  END_FUNCTIONS
346};
347
348void
349gdbscm_initialize_iterators (void)
350{
351  iterator_smob_tag = gdbscm_make_smob_type (iterator_smob_name,
352					     sizeof (iterator_smob));
353  scm_set_smob_print (iterator_smob_tag, itscm_print_iterator_smob);
354
355  gdbscm_define_functions (iterator_functions, 1);
356
357  /* We can make this more unique if it's necessary,
358     but this is good enough for now.  */
359  end_of_iteration = scm_from_latin1_keyword ("end-of-iteration");
360}
361