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