Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Simple iterators for GDB/Scheme. |
2 | ||
3 | Copyright (C) 2014 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 | The typedef for this struct is in guile-internal.h. */ | |
60 | ||
61 | struct _iterator_smob | |
62 | { | |
63 | /* This always appears first. */ | |
64 | gdb_smob base; | |
65 | ||
66 | /* The object being iterated over. */ | |
67 | SCM object; | |
68 | ||
69 | /* An arbitrary object describing the progress of the iteration. | |
70 | This is used by next_x to track progress. */ | |
71 | SCM progress; | |
72 | ||
73 | /* A procedure of one argument, the iterator. | |
74 | It returns the next object in the iteration. | |
75 | How to signal "end of iteration" is up to next_x. */ | |
76 | SCM next_x; | |
77 | }; | |
78 | ||
79 | static const char iterator_smob_name[] = "gdb:iterator"; | |
80 | ||
81 | /* The tag Guile knows the iterator smob by. */ | |
82 | static scm_t_bits iterator_smob_tag; | |
83 | ||
84 | /* A unique-enough marker to denote "end of iteration". */ | |
85 | static SCM end_of_iteration; | |
86 | ||
87 | const char * | |
88 | itscm_iterator_smob_name (void) | |
89 | { | |
90 | return iterator_smob_name; | |
91 | } | |
92 | ||
93 | SCM | |
94 | itscm_iterator_smob_object (iterator_smob *i_smob) | |
95 | { | |
96 | return i_smob->object; | |
97 | } | |
98 | ||
99 | SCM | |
100 | itscm_iterator_smob_progress (iterator_smob *i_smob) | |
101 | { | |
102 | return i_smob->progress; | |
103 | } | |
104 | ||
105 | void | |
106 | itscm_set_iterator_smob_progress_x (iterator_smob *i_smob, SCM progress) | |
107 | { | |
108 | i_smob->progress = progress; | |
109 | } | |
110 | \f | |
111 | /* Administrivia for iterator smobs. */ | |
112 | ||
113 | /* The smob "mark" function for <gdb:iterator>. */ | |
114 | ||
115 | static SCM | |
116 | itscm_mark_iterator_smob (SCM self) | |
117 | { | |
118 | iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self); | |
119 | ||
120 | scm_gc_mark (i_smob->object); | |
121 | scm_gc_mark (i_smob->progress); | |
122 | scm_gc_mark (i_smob->next_x); | |
123 | /* Do this last. */ | |
124 | return gdbscm_mark_gsmob (&i_smob->base); | |
125 | } | |
126 | ||
127 | /* The smob "print" function for <gdb:iterator>. */ | |
128 | ||
129 | static int | |
130 | itscm_print_iterator_smob (SCM self, SCM port, scm_print_state *pstate) | |
131 | { | |
132 | iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self); | |
133 | ||
134 | gdbscm_printf (port, "#<%s ", iterator_smob_name); | |
135 | scm_write (i_smob->object, port); | |
136 | scm_puts (" ", port); | |
137 | scm_write (i_smob->progress, port); | |
138 | scm_puts (" ", port); | |
139 | scm_write (i_smob->next_x, port); | |
140 | scm_puts (">", port); | |
141 | ||
142 | scm_remember_upto_here_1 (self); | |
143 | ||
144 | /* Non-zero means success. */ | |
145 | return 1; | |
146 | } | |
147 | ||
148 | /* Low level routine to make a <gdb:iterator> object. | |
149 | Caller must verify correctness of arguments. | |
150 | No exceptions are thrown. */ | |
151 | ||
152 | static SCM | |
153 | itscm_make_iterator_smob (SCM object, SCM progress, SCM next) | |
154 | { | |
155 | iterator_smob *i_smob = (iterator_smob *) | |
156 | scm_gc_malloc (sizeof (iterator_smob), iterator_smob_name); | |
157 | SCM i_scm; | |
158 | ||
159 | i_smob->object = object; | |
160 | i_smob->progress = progress; | |
161 | i_smob->next_x = next; | |
162 | i_scm = scm_new_smob (iterator_smob_tag, (scm_t_bits) i_smob); | |
163 | gdbscm_init_gsmob (&i_smob->base); | |
164 | ||
165 | return i_scm; | |
166 | } | |
167 | ||
168 | /* (make-iterator object object procedure) -> <gdb:iterator> */ | |
169 | ||
170 | SCM | |
171 | gdbscm_make_iterator (SCM object, SCM progress, SCM next) | |
172 | { | |
173 | SCM i_scm; | |
174 | ||
175 | SCM_ASSERT_TYPE (gdbscm_is_procedure (next), next, SCM_ARG3, FUNC_NAME, | |
176 | _("procedure")); | |
177 | ||
178 | i_scm = itscm_make_iterator_smob (object, progress, next); | |
179 | ||
180 | return i_scm; | |
181 | } | |
182 | ||
183 | /* Return non-zero if SCM is a <gdb:iterator> object. */ | |
184 | ||
185 | int | |
186 | itscm_is_iterator (SCM scm) | |
187 | { | |
188 | return SCM_SMOB_PREDICATE (iterator_smob_tag, scm); | |
189 | } | |
190 | ||
191 | /* (iterator? object) -> boolean */ | |
192 | ||
193 | static SCM | |
194 | gdbscm_iterator_p (SCM scm) | |
195 | { | |
196 | return scm_from_bool (itscm_is_iterator (scm)); | |
197 | } | |
198 | ||
199 | /* (end-of-iteration) -> an "end-of-iteration" marker | |
200 | We rely on this not being used as a data result of an iterator. */ | |
201 | ||
202 | SCM | |
203 | gdbscm_end_of_iteration (void) | |
204 | { | |
205 | return end_of_iteration; | |
206 | } | |
207 | ||
208 | /* Return non-zero if OBJ is the end-of-iteration marker. */ | |
209 | ||
210 | int | |
211 | itscm_is_end_of_iteration (SCM obj) | |
212 | { | |
213 | return scm_is_eq (obj, end_of_iteration); | |
214 | } | |
215 | ||
216 | /* (end-of-iteration? obj) -> boolean */ | |
217 | ||
218 | static SCM | |
219 | gdbscm_end_of_iteration_p (SCM obj) | |
220 | { | |
221 | return scm_from_bool (itscm_is_end_of_iteration (obj)); | |
222 | } | |
223 | ||
224 | /* Call the next! method on ITER, which must be a <gdb:iterator> object. | |
225 | Returns a <gdb:exception> object if an exception is thrown. | |
226 | OK_EXCPS is passed to gdbscm_safe_call_1. */ | |
227 | ||
228 | SCM | |
229 | itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps) | |
230 | { | |
231 | iterator_smob *i_smob; | |
232 | ||
233 | gdb_assert (itscm_is_iterator (iter)); | |
234 | ||
235 | i_smob = (iterator_smob *) SCM_SMOB_DATA (iter); | |
236 | return gdbscm_safe_call_1 (i_smob->next_x, iter, ok_excps); | |
237 | } | |
238 | \f | |
239 | /* Iterator methods. */ | |
240 | ||
241 | /* Returns the <gdb:iterator> smob in SELF. | |
242 | Throws an exception if SELF is not an iterator smob. */ | |
243 | ||
244 | SCM | |
245 | itscm_get_iterator_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
246 | { | |
247 | SCM_ASSERT_TYPE (itscm_is_iterator (self), self, arg_pos, func_name, | |
248 | iterator_smob_name); | |
249 | ||
250 | return self; | |
251 | } | |
252 | ||
253 | /* (iterator-object <gdb:iterator>) -> object */ | |
254 | ||
255 | static SCM | |
256 | gdbscm_iterator_object (SCM self) | |
257 | { | |
258 | SCM i_scm; | |
259 | iterator_smob *i_smob; | |
260 | ||
261 | i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
262 | i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm); | |
263 | ||
264 | return i_smob->object; | |
265 | } | |
266 | ||
267 | /* (iterator-progress <gdb:iterator>) -> object */ | |
268 | ||
269 | static SCM | |
270 | gdbscm_iterator_progress (SCM self) | |
271 | { | |
272 | SCM i_scm; | |
273 | iterator_smob *i_smob; | |
274 | ||
275 | i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
276 | i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm); | |
277 | ||
278 | return i_smob->progress; | |
279 | } | |
280 | ||
281 | /* (set-iterator-progress! <gdb:iterator> object) -> unspecified */ | |
282 | ||
283 | static SCM | |
284 | gdbscm_set_iterator_progress_x (SCM self, SCM value) | |
285 | { | |
286 | SCM i_scm; | |
287 | iterator_smob *i_smob; | |
288 | ||
289 | i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
290 | i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm); | |
291 | ||
292 | i_smob->progress = value; | |
293 | return SCM_UNSPECIFIED; | |
294 | } | |
295 | ||
296 | /* (iterator-next! <gdb:iterator>) -> object | |
297 | The result is the next value in the iteration or some "end" marker. | |
298 | It is up to each iterator's next! function to specify what its end | |
299 | marker is. */ | |
300 | ||
301 | static SCM | |
302 | gdbscm_iterator_next_x (SCM self) | |
303 | { | |
304 | SCM i_scm; | |
305 | iterator_smob *i_smob; | |
306 | ||
307 | i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
308 | i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm); | |
309 | /* We leave type-checking of the procedure to gdbscm_safe_call_1. */ | |
310 | ||
311 | return gdbscm_safe_call_1 (i_smob->next_x, self, NULL); | |
312 | } | |
313 | \f | |
314 | /* Initialize the Scheme iterator code. */ | |
315 | ||
316 | static const scheme_function iterator_functions[] = | |
317 | { | |
318 | { "make-iterator", 3, 0, 0, gdbscm_make_iterator, | |
319 | "\ | |
320 | Create a <gdb:iterator> object.\n\ | |
321 | \n\ | |
322 | Arguments: object progress next!\n\ | |
323 | object: The object to iterate over.\n\ | |
324 | progress: An object to use to track progress of the iteration.\n\ | |
325 | next!: A procedure of one argument, the iterator.\n\ | |
326 | Returns the next element in the iteration or an implementation-chosen\n\ | |
327 | value to signify iteration is complete.\n\ | |
328 | By convention end-of-iteration should be marked with (end-of-iteration)\n\ | |
329 | from module (gdb iterator)." }, | |
330 | ||
331 | { "iterator?", 1, 0, 0, gdbscm_iterator_p, | |
332 | "\ | |
333 | Return #t if the object is a <gdb:iterator> object." }, | |
334 | ||
335 | { "iterator-object", 1, 0, 0, gdbscm_iterator_object, | |
336 | "\ | |
337 | Return the object being iterated over." }, | |
338 | ||
339 | { "iterator-progress", 1, 0, 0, gdbscm_iterator_progress, | |
340 | "\ | |
341 | Return the progress object of the iterator." }, | |
342 | ||
343 | { "set-iterator-progress!", 2, 0, 0, gdbscm_set_iterator_progress_x, | |
344 | "\ | |
345 | Set the progress object of the iterator." }, | |
346 | ||
347 | { "iterator-next!", 1, 0, 0, gdbscm_iterator_next_x, | |
348 | "\ | |
349 | Invoke the next! procedure of the iterator and return its result." }, | |
350 | ||
351 | { "end-of-iteration", 0, 0, 0, gdbscm_end_of_iteration, | |
352 | "\ | |
353 | Return the end-of-iteration marker." }, | |
354 | ||
355 | { "end-of-iteration?", 1, 0, 0, gdbscm_end_of_iteration_p, | |
356 | "\ | |
357 | Return #t if the object is the end-of-iteration marker." }, | |
358 | ||
359 | END_FUNCTIONS | |
360 | }; | |
361 | ||
362 | void | |
363 | gdbscm_initialize_iterators (void) | |
364 | { | |
365 | iterator_smob_tag = gdbscm_make_smob_type (iterator_smob_name, | |
366 | sizeof (iterator_smob)); | |
367 | scm_set_smob_mark (iterator_smob_tag, itscm_mark_iterator_smob); | |
368 | scm_set_smob_print (iterator_smob_tag, itscm_print_iterator_smob); | |
369 | ||
370 | gdbscm_define_functions (iterator_functions, 1); | |
371 | ||
372 | /* We can make this more unique if it's necessary, | |
373 | but this is good enough for now. */ | |
374 | end_of_iteration = scm_from_latin1_keyword ("end-of-iteration"); | |
375 | } |