Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Simple iterators for GDB/Scheme. |
2 | ||
61baf725 | 3 | Copyright (C) 2014-2017 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 '()) | |
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 | ||
ed3ef339 DE |
113 | /* The smob "print" function for <gdb:iterator>. */ |
114 | ||
115 | static int | |
116 | itscm_print_iterator_smob (SCM self, SCM port, scm_print_state *pstate) | |
117 | { | |
118 | iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self); | |
119 | ||
120 | gdbscm_printf (port, "#<%s ", iterator_smob_name); | |
121 | scm_write (i_smob->object, port); | |
122 | scm_puts (" ", port); | |
123 | scm_write (i_smob->progress, port); | |
124 | scm_puts (" ", port); | |
125 | scm_write (i_smob->next_x, port); | |
126 | scm_puts (">", port); | |
127 | ||
128 | scm_remember_upto_here_1 (self); | |
129 | ||
130 | /* Non-zero means success. */ | |
131 | return 1; | |
132 | } | |
133 | ||
134 | /* Low level routine to make a <gdb:iterator> object. | |
135 | Caller must verify correctness of arguments. | |
136 | No exceptions are thrown. */ | |
137 | ||
138 | static SCM | |
139 | itscm_make_iterator_smob (SCM object, SCM progress, SCM next) | |
140 | { | |
141 | iterator_smob *i_smob = (iterator_smob *) | |
142 | scm_gc_malloc (sizeof (iterator_smob), iterator_smob_name); | |
143 | SCM i_scm; | |
144 | ||
145 | i_smob->object = object; | |
146 | i_smob->progress = progress; | |
147 | i_smob->next_x = next; | |
148 | i_scm = scm_new_smob (iterator_smob_tag, (scm_t_bits) i_smob); | |
149 | gdbscm_init_gsmob (&i_smob->base); | |
150 | ||
151 | return i_scm; | |
152 | } | |
153 | ||
154 | /* (make-iterator object object procedure) -> <gdb:iterator> */ | |
155 | ||
156 | SCM | |
157 | gdbscm_make_iterator (SCM object, SCM progress, SCM next) | |
158 | { | |
159 | SCM i_scm; | |
160 | ||
161 | SCM_ASSERT_TYPE (gdbscm_is_procedure (next), next, SCM_ARG3, FUNC_NAME, | |
162 | _("procedure")); | |
163 | ||
164 | i_scm = itscm_make_iterator_smob (object, progress, next); | |
165 | ||
166 | return i_scm; | |
167 | } | |
168 | ||
169 | /* Return non-zero if SCM is a <gdb:iterator> object. */ | |
170 | ||
171 | int | |
172 | itscm_is_iterator (SCM scm) | |
173 | { | |
174 | return SCM_SMOB_PREDICATE (iterator_smob_tag, scm); | |
175 | } | |
176 | ||
177 | /* (iterator? object) -> boolean */ | |
178 | ||
179 | static SCM | |
180 | gdbscm_iterator_p (SCM scm) | |
181 | { | |
182 | return scm_from_bool (itscm_is_iterator (scm)); | |
183 | } | |
184 | ||
185 | /* (end-of-iteration) -> an "end-of-iteration" marker | |
186 | We rely on this not being used as a data result of an iterator. */ | |
187 | ||
188 | SCM | |
189 | gdbscm_end_of_iteration (void) | |
190 | { | |
191 | return end_of_iteration; | |
192 | } | |
193 | ||
194 | /* Return non-zero if OBJ is the end-of-iteration marker. */ | |
195 | ||
196 | int | |
197 | itscm_is_end_of_iteration (SCM obj) | |
198 | { | |
199 | return scm_is_eq (obj, end_of_iteration); | |
200 | } | |
201 | ||
202 | /* (end-of-iteration? obj) -> boolean */ | |
203 | ||
204 | static SCM | |
205 | gdbscm_end_of_iteration_p (SCM obj) | |
206 | { | |
207 | return scm_from_bool (itscm_is_end_of_iteration (obj)); | |
208 | } | |
209 | ||
210 | /* Call the next! method on ITER, which must be a <gdb:iterator> object. | |
211 | Returns a <gdb:exception> object if an exception is thrown. | |
212 | OK_EXCPS is passed to gdbscm_safe_call_1. */ | |
213 | ||
214 | SCM | |
215 | itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps) | |
216 | { | |
217 | iterator_smob *i_smob; | |
218 | ||
219 | gdb_assert (itscm_is_iterator (iter)); | |
220 | ||
221 | i_smob = (iterator_smob *) SCM_SMOB_DATA (iter); | |
222 | return gdbscm_safe_call_1 (i_smob->next_x, iter, ok_excps); | |
223 | } | |
224 | \f | |
225 | /* Iterator methods. */ | |
226 | ||
227 | /* Returns the <gdb:iterator> smob in SELF. | |
228 | Throws an exception if SELF is not an iterator smob. */ | |
229 | ||
230 | SCM | |
231 | itscm_get_iterator_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
232 | { | |
233 | SCM_ASSERT_TYPE (itscm_is_iterator (self), self, arg_pos, func_name, | |
234 | iterator_smob_name); | |
235 | ||
236 | return self; | |
237 | } | |
238 | ||
239 | /* (iterator-object <gdb:iterator>) -> object */ | |
240 | ||
241 | static SCM | |
242 | gdbscm_iterator_object (SCM self) | |
243 | { | |
244 | SCM i_scm; | |
245 | iterator_smob *i_smob; | |
246 | ||
247 | i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
248 | i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm); | |
249 | ||
250 | return i_smob->object; | |
251 | } | |
252 | ||
253 | /* (iterator-progress <gdb:iterator>) -> object */ | |
254 | ||
255 | static SCM | |
256 | gdbscm_iterator_progress (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->progress; | |
265 | } | |
266 | ||
267 | /* (set-iterator-progress! <gdb:iterator> object) -> unspecified */ | |
268 | ||
269 | static SCM | |
270 | gdbscm_set_iterator_progress_x (SCM self, SCM value) | |
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 | i_smob->progress = value; | |
279 | return SCM_UNSPECIFIED; | |
280 | } | |
281 | ||
282 | /* (iterator-next! <gdb:iterator>) -> object | |
283 | The result is the next value in the iteration or some "end" marker. | |
284 | It is up to each iterator's next! function to specify what its end | |
285 | marker is. */ | |
286 | ||
287 | static SCM | |
288 | gdbscm_iterator_next_x (SCM self) | |
289 | { | |
290 | SCM i_scm; | |
291 | iterator_smob *i_smob; | |
292 | ||
293 | i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
294 | i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm); | |
295 | /* We leave type-checking of the procedure to gdbscm_safe_call_1. */ | |
296 | ||
297 | return gdbscm_safe_call_1 (i_smob->next_x, self, NULL); | |
298 | } | |
299 | \f | |
300 | /* Initialize the Scheme iterator code. */ | |
301 | ||
302 | static const scheme_function iterator_functions[] = | |
303 | { | |
72e02483 | 304 | { "make-iterator", 3, 0, 0, as_a_scm_t_subr (gdbscm_make_iterator), |
ed3ef339 DE |
305 | "\ |
306 | Create a <gdb:iterator> object.\n\ | |
307 | \n\ | |
308 | Arguments: object progress next!\n\ | |
309 | object: The object to iterate over.\n\ | |
310 | progress: An object to use to track progress of the iteration.\n\ | |
311 | next!: A procedure of one argument, the iterator.\n\ | |
312 | Returns the next element in the iteration or an implementation-chosen\n\ | |
313 | value to signify iteration is complete.\n\ | |
314 | By convention end-of-iteration should be marked with (end-of-iteration)\n\ | |
315 | from module (gdb iterator)." }, | |
316 | ||
72e02483 | 317 | { "iterator?", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_p), |
ed3ef339 DE |
318 | "\ |
319 | Return #t if the object is a <gdb:iterator> object." }, | |
320 | ||
72e02483 | 321 | { "iterator-object", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_object), |
ed3ef339 DE |
322 | "\ |
323 | Return the object being iterated over." }, | |
324 | ||
72e02483 | 325 | { "iterator-progress", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_progress), |
ed3ef339 DE |
326 | "\ |
327 | Return the progress object of the iterator." }, | |
328 | ||
72e02483 PA |
329 | { "set-iterator-progress!", 2, 0, 0, |
330 | as_a_scm_t_subr (gdbscm_set_iterator_progress_x), | |
ed3ef339 DE |
331 | "\ |
332 | Set the progress object of the iterator." }, | |
333 | ||
72e02483 | 334 | { "iterator-next!", 1, 0, 0, as_a_scm_t_subr (gdbscm_iterator_next_x), |
ed3ef339 DE |
335 | "\ |
336 | Invoke the next! procedure of the iterator and return its result." }, | |
337 | ||
72e02483 | 338 | { "end-of-iteration", 0, 0, 0, as_a_scm_t_subr (gdbscm_end_of_iteration), |
ed3ef339 DE |
339 | "\ |
340 | Return the end-of-iteration marker." }, | |
341 | ||
72e02483 | 342 | { "end-of-iteration?", 1, 0, 0, as_a_scm_t_subr (gdbscm_end_of_iteration_p), |
ed3ef339 DE |
343 | "\ |
344 | Return #t if the object is the end-of-iteration marker." }, | |
345 | ||
346 | END_FUNCTIONS | |
347 | }; | |
348 | ||
349 | void | |
350 | gdbscm_initialize_iterators (void) | |
351 | { | |
352 | iterator_smob_tag = gdbscm_make_smob_type (iterator_smob_name, | |
353 | sizeof (iterator_smob)); | |
ed3ef339 DE |
354 | scm_set_smob_print (iterator_smob_tag, itscm_print_iterator_smob); |
355 | ||
356 | gdbscm_define_functions (iterator_functions, 1); | |
357 | ||
358 | /* We can make this more unique if it's necessary, | |
359 | but this is good enough for now. */ | |
360 | end_of_iteration = scm_from_latin1_keyword ("end-of-iteration"); | |
361 | } |