GDB (xrefs)
Loading...
Searching...
No Matches
scm-iterator.c
Go to the documentation of this file.
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
61{
62 /* This always appears first. */
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. */
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". */
85
86const char *
91
92SCM
94{
95 return i_smob->object;
96}
97
98SCM
100{
101 return i_smob->progress;
102}
103
104void
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
172{
173 return SCM_SMOB_PREDICATE (iterator_smob_tag, scm);
174}
175
176/* (iterator? object) -> boolean */
177
178static 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
189{
190 return end_of_iteration;
191}
192
193/* Return non-zero if OBJ is the end-of-iteration marker. */
194
195int
197{
198 return scm_is_eq (obj, end_of_iteration);
199}
200
201/* (end-of-iteration? obj) -> boolean */
202
203static SCM
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
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,
234
235 return self;
236}
237
238/* (iterator-object <gdb:iterator>) -> object */
239
240static SCM
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
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
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
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
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,
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
346};
347
348void
350{
352 sizeof (iterator_smob));
353 scm_set_smob_print (iterator_smob_tag, itscm_print_iterator_smob);
354
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}
static struct parser_state * pstate
Definition ada-exp.c:101
#define END_FUNCTIONS
int gdbscm_is_procedure(SCM proc)
Definition scm-utils.c:592
void gdbscm_init_gsmob(gdb_smob *base)
Definition scm-gsmob.c:140
SCM gdbscm_safe_call_1(SCM proc, SCM arg0, excp_matcher_func *ok_excps)
int excp_matcher_func(SCM key)
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition scm-utils.c:44
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition scm-gsmob.c:103
static scm_t_subr as_a_scm_t_subr(SCM(*func)(void))
#define FUNC_NAME
int value
Definition py-param.c:79
static SCM gdbscm_iterator_progress(SCM self)
void itscm_set_iterator_smob_progress_x(iterator_smob *i_smob, SCM progress)
SCM itscm_iterator_smob_object(iterator_smob *i_smob)
static scm_t_bits iterator_smob_tag
SCM itscm_iterator_smob_progress(iterator_smob *i_smob)
static SCM gdbscm_iterator_next_x(SCM self)
static const scheme_function iterator_functions[]
void gdbscm_initialize_iterators(void)
static SCM end_of_iteration
SCM gdbscm_make_iterator(SCM object, SCM progress, SCM next)
static int itscm_print_iterator_smob(SCM self, SCM port, scm_print_state *pstate)
SCM itscm_safe_call_next_x(SCM iter, excp_matcher_func *ok_excps)
static SCM gdbscm_iterator_p(SCM scm)
static SCM gdbscm_set_iterator_progress_x(SCM self, SCM value)
static SCM gdbscm_iterator_object(SCM self)
int itscm_is_iterator(SCM scm)
const char * itscm_iterator_smob_name(void)
static SCM itscm_make_iterator_smob(SCM object, SCM progress, SCM next)
int itscm_is_end_of_iteration(SCM obj)
static const char iterator_smob_name[]
SCM itscm_get_iterator_arg_unsafe(SCM self, int arg_pos, const char *func_name)
static SCM gdbscm_end_of_iteration_p(SCM obj)
SCM gdbscm_end_of_iteration(void)
gdb_smob base
Definition value.h:130