Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Simple iterators for GDB/Scheme. |
2 | ||
88b9d363 | 3 | Copyright (C) 2014-2022 Free Software Foundation, Inc. |
ed3ef339 DE |
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 '()) | |
dda83cd7 SM |
38 | end-marker |
39 | (begin | |
ed3ef339 DE |
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 | |
f99b5177 | 58 | too expensive. */ |
ed3ef339 | 59 | |
f99b5177 | 60 | struct iterator_smob |
ed3ef339 DE |
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 | ||
78 | static const char iterator_smob_name[] = "gdb:iterator"; | |
79 | ||
80 | /* The tag Guile knows the iterator smob by. */ | |
81 | static scm_t_bits iterator_smob_tag; | |
82 | ||
83 | /* A unique-enough marker to denote "end of iteration". */ | |
84 | static SCM end_of_iteration; | |
85 | ||
86 | const char * | |
87 | itscm_iterator_smob_name (void) | |
88 | { | |
89 | return iterator_smob_name; | |
90 | } | |
91 | ||
92 | SCM | |
93 | itscm_iterator_smob_object (iterator_smob *i_smob) | |
94 | { | |
95 | return i_smob->object; | |
96 | } | |
97 | ||
98 | SCM | |
99 | itscm_iterator_smob_progress (iterator_smob *i_smob) | |
100 | { | |
101 | return i_smob->progress; | |
102 | } | |
103 | ||
104 | void | |
105 | itscm_set_iterator_smob_progress_x (iterator_smob *i_smob, SCM progress) | |
106 | { | |
107 | i_smob->progress = progress; | |
108 | } | |
109 | \f | |
110 | /* Administrivia for iterator smobs. */ | |
111 | ||
ed3ef339 DE |
112 | /* The smob "print" function for <gdb:iterator>. */ |
113 | ||
114 | static int | |
115 | itscm_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 | ||
137 | static SCM | |
138 | itscm_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 | ||
155 | SCM | |
156 | gdbscm_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 | ||
170 | int | |
171 | itscm_is_iterator (SCM scm) | |
172 | { | |
173 | return SCM_SMOB_PREDICATE (iterator_smob_tag, scm); | |
174 | } | |
175 | ||
176 | /* (iterator? object) -> boolean */ | |
177 | ||
178 | static SCM | |
179 | gdbscm_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 | ||
187 | SCM | |
188 | gdbscm_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 | ||
195 | int | |
196 | itscm_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 | ||
203 | static SCM | |
204 | gdbscm_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 | ||
213 | SCM | |
214 | itscm_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 | \f | |
224 | /* Iterator methods. */ | |
225 | ||
226 | /* Returns the <gdb:iterator> smob in SELF. | |
227 | Throws an exception if SELF is not an iterator smob. */ | |
228 | ||
229 | SCM | |
230 | itscm_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 | ||
240 | static SCM | |
241 | gdbscm_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 | ||
254 | static SCM | |
255 | gdbscm_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 | ||
268 | static SCM | |
269 | gdbscm_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 | ||
286 | static SCM | |
287 | gdbscm_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 | \f | |
299 | /* Initialize the Scheme iterator code. */ | |
300 | ||
301 | static const scheme_function iterator_functions[] = | |
302 | { | |
72e02483 | 303 | { "make-iterator", 3, 0, 0, as_a_scm_t_subr (gdbscm_make_iterator), |
ed3ef339 DE |
304 | "\ |
305 | Create 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 | ||
72e02483 | 316 | { "iterator?", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_p), |
ed3ef339 DE |
317 | "\ |
318 | Return #t if the object is a <gdb:iterator> object." }, | |
319 | ||
72e02483 | 320 | { "iterator-object", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_object), |
ed3ef339 DE |
321 | "\ |
322 | Return the object being iterated over." }, | |
323 | ||
72e02483 | 324 | { "iterator-progress", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_progress), |
ed3ef339 DE |
325 | "\ |
326 | Return the progress object of the iterator." }, | |
327 | ||
72e02483 PA |
328 | { "set-iterator-progress!", 2, 0, 0, |
329 | as_a_scm_t_subr (gdbscm_set_iterator_progress_x), | |
ed3ef339 DE |
330 | "\ |
331 | Set the progress object of the iterator." }, | |
332 | ||
72e02483 | 333 | { "iterator-next!", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_next_x), |
ed3ef339 DE |
334 | "\ |
335 | Invoke the next! procedure of the iterator and return its result." }, | |
336 | ||
72e02483 | 337 | { "end-of-iteration", 0, 0, 0, as_a_scm_t_subr (gdbscm_end_of_iteration), |
ed3ef339 DE |
338 | "\ |
339 | Return the end-of-iteration marker." }, | |
340 | ||
72e02483 | 341 | { "end-of-iteration?", 1, 0, 0, as_a_scm_t_subr (gdbscm_end_of_iteration_p), |
ed3ef339 DE |
342 | "\ |
343 | Return #t if the object is the end-of-iteration marker." }, | |
344 | ||
345 | END_FUNCTIONS | |
346 | }; | |
347 | ||
348 | void | |
349 | gdbscm_initialize_iterators (void) | |
350 | { | |
351 | iterator_smob_tag = gdbscm_make_smob_type (iterator_smob_name, | |
352 | sizeof (iterator_smob)); | |
ed3ef339 DE |
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 | } |