1 /*
2 Copyright (c) 1991-2007 Thomas T. Wetmore IV
3
4 Permission is hereby granted, free of charge, to any person
5 obtaining a copy of this software and associated documentation
6 files (the "Software"), to deal in the Software without
7 restriction, including without limitation the rights to use, copy,
8 modify, merge, publish, distribute, sublicense, and/or sell copies
9 of the Software, and to permit persons to whom the Software is
10 furnished to do so, subject to the following conditions:
11
12 The above copyright notice and this permission notice shall be
13 included in all copies or substantial portions of the Software.
14
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
18 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
19 BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
20 ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
22 SOFTWARE.
23 */
24 /*=============================================================
25 * builtin_list.c -- Report language (interpreter) list functions
26 *===========================================================*/
27
28 #include "sys_inc.h"
29 #include "llstdlib.h"
30
31 #include "interpi.h"
32
33 /*********************************************
34 * local function prototypes
35 *********************************************/
36
37 static VPTR create_list_value_pvalue(LIST list);
38
39 /*********************************************
40 * local variables
41 *********************************************/
42
43 static struct tag_rfmt rpt_long_rfmt; /* short form report format */
44 static struct tag_rfmt rpt_shrt_rfmt; /* long form report format */
45
46 /*********************************************
47 * local function definitions
48 * body of module
49 *********************************************/
50
51
52 /*============================+
53 * llrpt_clear -- Clear a list, set, indiseq
54 * usage: clear(LIST) -> VOID
55 *===========================*/
56 PVALUE
llrpt_clear(PNODE node,SYMTAB stab,BOOLEAN * eflg)57 llrpt_clear (PNODE node, SYMTAB stab, BOOLEAN *eflg)
58 {
59 LIST list;
60 PNODE argvar = builtin_args(node);
61 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
62 if (*eflg) {
63 prog_var_error(node, stab, argvar, val, nonlst1, "1");
64 delete_pvalue(val);
65 return NULL;
66 }
67 list = pvalue_to_list(val);
68 make_list_empty(list); /* leaking elements? 2005-02-05 Perry */
69 return NULL;
70 }
71 /*============================+
72 * llrpt_list -- Create list
73 * usage: list(IDENT) -> VOID
74 *===========================*/
75 PVALUE
llrpt_list(PNODE node,SYMTAB stab,BOOLEAN * eflg)76 llrpt_list (PNODE node, SYMTAB stab, BOOLEAN *eflg)
77 {
78
79 PVALUE newval=0;
80 PNODE argvar = builtin_args(node);
81 if (!iistype(argvar, IIDENT)) {
82 prog_var_error(node, stab, argvar, NULL, nonvar1, "list");
83 *eflg = TRUE;
84 return NULL;
85 }
86 *eflg = FALSE;
87
88 newval = create_new_pvalue_list();
89
90 assign_iden(stab, iident_name(argvar), newval);
91 return NULL;
92 }
93 /*=======================================+
94 * llrpt_push -- Push element on front of list
95 * usage: push(LIST, ANY) -> VOID
96 *======================================*/
97 PVALUE
llrpt_push(PNODE node,SYMTAB stab,BOOLEAN * eflg)98 llrpt_push (PNODE node, SYMTAB stab, BOOLEAN *eflg)
99 {
100 PNODE argvar = builtin_args(node);
101 LIST list=0;
102 PVALUE el=0;
103 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
104 if (*eflg) {
105 prog_var_error(node, stab, argvar, val, nonlst1, "1");
106 delete_pvalue(val);
107 return NULL;
108 }
109 el = evaluate(argvar=inext(argvar), stab, eflg);
110 if (*eflg || !el) {
111 /* TODO - use std errors */
112 *eflg = TRUE;
113 prog_error(node, "2nd arg to push is in error");
114 return NULL;
115 }
116 list = pvalue_to_list(val);
117 delete_pvalue_ptr(&val);
118 push_list(list, el);
119 return NULL;
120 }
121 /*======================================+
122 * llrpt_inlist -- see if element is in list
123 * usage: inlist(LIST, STRING) -> BOOL
124 *=====================================*/
125 PVALUE
llrpt_inlist(PNODE node,SYMTAB stab,BOOLEAN * eflg)126 llrpt_inlist (PNODE node, SYMTAB stab, BOOLEAN *eflg)
127 {
128 PNODE argvar = builtin_args(node);
129 LIST list=0;
130 PVALUE el=0;
131 BOOLEAN bFound;
132 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
133 if (*eflg) {
134 prog_var_error(node, stab, argvar, val, nonlstx, "inlist", "1");
135 delete_pvalue(val);
136 return NULL;
137 }
138 el = evaluate(argvar=inext(argvar), stab, eflg);
139 if (*eflg || !el) {
140 *eflg = TRUE;
141 prog_var_error(node, stab, argvar, el, badargx, "inlist", "2");
142 delete_pvalue(el);
143 return NULL;
144 }
145 list = pvalue_to_list(val);
146 bFound = in_list(list, el, eqv_pvalues) >= 0;
147 set_pvalue_bool(val, bFound);
148 delete_pvalue_ptr(&el);
149 return val;
150 }
151 /*====================================+
152 * llrpt_enqueue -- Enqueue element on list
153 * usage: enqueue(LIST, ANY) -> VOID
154 *===================================*/
155 PVALUE
llrpt_enqueue(PNODE node,SYMTAB stab,BOOLEAN * eflg)156 llrpt_enqueue (PNODE node, SYMTAB stab, BOOLEAN *eflg)
157 {
158 PNODE argvar = builtin_args(node);
159 LIST list=NULL;
160 PVALUE el=NULL;
161 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
162 if (*eflg) {
163 prog_var_error(node, stab, argvar, val, nonlstx, "enqueue", "1");
164 delete_pvalue(val);
165 return NULL;
166 }
167 el = evaluate(argvar=inext(argvar), stab, eflg);
168 if (*eflg || !el) {
169 *eflg = TRUE;
170 prog_var_error(node, stab, argvar, el, badargx, "enqueue", "2");
171 delete_pvalue(el);
172 return NULL;
173 }
174 list = pvalue_to_list(val);
175 delete_pvalue_ptr(&val);
176 enqueue_list(list, el);
177 return NULL;
178 }
179 /*========================================+
180 * llrpt_requeue -- Add element to back of list
181 * usage: requeue(LIST, ANY) -> VOID
182 *=======================================*/
183 PVALUE
llrpt_requeue(PNODE node,SYMTAB stab,BOOLEAN * eflg)184 llrpt_requeue (PNODE node, SYMTAB stab, BOOLEAN *eflg)
185 {
186 PNODE argvar = builtin_args(node);
187 LIST list=NULL;
188 PVALUE el=NULL;
189 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
190 if (*eflg || !val) {
191 *eflg = TRUE;
192 prog_error(node, "1st arg to requeue is not a list");
193 return NULL;
194 }
195 el = evaluate(argvar=inext(argvar), stab, eflg);
196 if (*eflg || !el) {
197 *eflg = TRUE;
198 prog_error(node, "2nd arg to requeue is in error");
199 return NULL;
200 }
201 list = pvalue_to_list(val);
202 delete_pvalue_ptr(&val);
203 back_list(list, el);
204 return NULL;
205 }
206 /*=======================================+
207 * llrpt_pop -- Pop element from front of list
208 * usage: pop(LIST) -> ANY
209 *======================================*/
210 PVALUE
llrpt_pop(PNODE node,SYMTAB stab,BOOLEAN * eflg)211 llrpt_pop (PNODE node, SYMTAB stab, BOOLEAN *eflg)
212 {
213 LIST list=0;
214 PNODE argvar = builtin_args(node);
215 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
216 if (*eflg) {
217 prog_error(node, "the arg to pop is not a list");
218 return NULL;
219 }
220 list = pvalue_to_list(val);
221 delete_pvalue_ptr(&val);
222 if (is_empty_list(list)) return create_pvalue_any();
223 return (PVALUE) pop_list(list);
224 }
225 /*=============================================+
226 * llrpt_dequeue -- Remove element from back of list
227 * usage: dequeue(LIST) -> ANY
228 *============================================*/
229 PVALUE
llrpt_dequeue(PNODE node,SYMTAB stab,BOOLEAN * eflg)230 llrpt_dequeue (PNODE node, SYMTAB stab, BOOLEAN *eflg)
231 {
232 LIST list=0;
233 PNODE argvar = builtin_args(node);
234 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
235 if (*eflg || !val) {
236 *eflg = TRUE;
237 prog_error(node, nonlst1, "dequeue");
238 return NULL;
239 }
240 list = pvalue_to_list(val);
241 delete_pvalue(val);
242 val = (PVALUE) dequeue_list(list);
243 if (!val) return create_pvalue_any();
244 return val;
245 }
246 /*===================================
247 * llrpt_empty is in builtin.c, as it is shared by table, list, and seq
248 *=================================*/
249 /*===================================
250 * create_list_value_pvalue --
251 * Create filler element
252 * Used when accessing list as an array
253 * Created: 2002/12/29 (Perry Rapp)
254 *=================================*/
255 static VPTR
create_list_value_pvalue(LIST list)256 create_list_value_pvalue (LIST list)
257 {
258 list=list; /* unused */
259 return create_pvalue_any();
260 }
261 /*==================================+
262 * llrpt_getel -- Get nth value from list
263 * usage: getel(LIST, INT) -> ANY
264 *=================================*/
265 PVALUE
llrpt_getel(PNODE node,SYMTAB stab,BOOLEAN * eflg)266 llrpt_getel (PNODE node, SYMTAB stab, BOOLEAN *eflg)
267 {
268 LIST list;
269 INT ind;
270 PNODE argvar = builtin_args(node);
271 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
272 if (*eflg || !val) {
273 *eflg = TRUE;
274 prog_var_error(node, stab, argvar, val, nonlstx, "getel", "1");
275 delete_pvalue(val);
276 return NULL;
277 }
278 list = pvalue_to_list(val);
279 delete_pvalue(val);
280 val = eval_and_coerce(PINT, argvar=inext(argvar), stab, eflg);
281 if (*eflg || !val) {
282 *eflg = TRUE;
283 prog_var_error(node, stab, argvar, val, nonlstx, "getel", "2");
284 delete_pvalue(val);
285 return NULL;
286 }
287 ind = pvalue_to_int(val);
288 delete_pvalue(val);
289 if (!(val = (PVALUE) get_list_element(list, ind, &create_list_value_pvalue)))
290 return create_pvalue_any();
291 return copy_pvalue(val);
292 }
293 /*=======================================+
294 * llrpt_setel -- Set nth value in list
295 * usage: setel(LIST, INT, ANY) -> VOID
296 *======================================*/
297 PVALUE
llrpt_setel(PNODE node,SYMTAB stab,BOOLEAN * eflg)298 llrpt_setel (PNODE node, SYMTAB stab, BOOLEAN *eflg)
299 {
300 LIST list=0;
301 INT ind=0;
302 PNODE argvar = builtin_args(node);
303 PVALUE old=0;
304 PVALUE val = eval_and_coerce(PLIST, argvar, stab, eflg);
305 if (*eflg || !val) {
306 *eflg = TRUE;
307 prog_var_error(node, stab, argvar, val, nonlstx, "setel", "1");
308 delete_pvalue(val);
309 return NULL;
310 }
311 list = pvalue_to_list(val);
312 delete_pvalue(val);
313 argvar = inext(argvar);
314 val = eval_and_coerce(PINT, argvar, stab, eflg);
315 if (*eflg) {
316 *eflg = TRUE;
317 prog_var_error(node, stab, argvar, val, nonintx, "setel", "2");
318 delete_pvalue(val);
319 return NULL;
320 }
321 ind = pvalue_to_int(val);
322 delete_pvalue(val);
323 val = evaluate(argvar=inext(argvar), stab, eflg);
324 if (*eflg || !val) {
325 *eflg = TRUE;
326 prog_var_error(node, stab, argvar, val, badargx, "setel", "3");
327 delete_pvalue(val);
328 return NULL;
329 }
330 old = (PVALUE) get_list_element(list, ind, &create_list_value_pvalue);
331 if(old) delete_pvalue(old);
332 set_list_element(list, ind, val, &create_list_value_pvalue);
333 return NULL;
334 }
335 /*===================================
336 * llrpt_length is in builtin.c, as it is shared by table, list, and seq
337 *=================================*/
338 /*===============================+
339 * llrpt_dup -- Dup operation
340 * usage: dup(LIST) -> LIST
341 *==============================*/
342 PVALUE
llrpt_dup(PNODE node,SYMTAB stab,BOOLEAN * eflg)343 llrpt_dup (PNODE node, SYMTAB stab, BOOLEAN *eflg)
344 {
345 PNODE argvar = builtin_args(node);
346 LIST list=0;
347 LIST newlist=0;
348 PVALUE val=0, newval=0;
349 INT i=0;
350
351 val = evaluate(argvar, stab, eflg);
352 if (*eflg || !val) {
353 *eflg = TRUE;
354 prog_var_error(node, stab, argvar, val, badargx, "dup", "1");
355 return NULL;
356 }
357 /* traverse and copy */
358 list = pvalue_to_list(val);
359 delete_pvalue_ptr(&val);
360 newlist = create_list3(delete_vptr_pvalue);
361 for (i=0; i<length_list(list); i++) {
362 newval = (PVALUE) get_list_element(list, i+1, NULL);
363 enqueue_list(newlist, copy_pvalue(newval));
364 }
365 /* assign new list */
366 newval = create_pvalue_from_list(newlist);
367 release_list(newlist); /* release our ref to newlist */
368 return newval;
369 }
370