1 /*
2 Copyright (c) 1991-1999 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 /* modified 05 Jan 2000 by Paul B. McBride (pmcbride@tiac.net) */
25 /*==============================================================
26 * eval.c -- Evaulate report program expressions
27 * Copyright(c) 1991-95 by T. T. Wetmore IV; all rights reserved
28 * 2.3.4 - 24 Jun 93 2.3.5 - 17 Aug 93
29 * 3.0.0 - 29 Jun 94 3.0.2 - 22 Dec 94
30 * 3.0.3 - 23 Nov 95
31 *============================================================*/
32
33 #ifdef HAVE_CONFIG_H
34 #include "config.h"
35 #endif
36
37 #include "llstdlib.h"
38 #include "table.h"
39 #include "translat.h"
40 #include "gedcom.h"
41 #include "cache.h"
42 #include "interpi.h"
43 #include "feedback.h"
44 #include "lloptions.h"
45
46 static void trace_outv(STRING fmt, va_list args);
47
48
49 extern BOOLEAN explicitvars;
50
51 /*=============================+
52 * evaluate -- Generic evaluator
53 *============================*/
54 PVALUE
evaluate(PNODE node,SYMTAB stab,BOOLEAN * eflg)55 evaluate (PNODE node, SYMTAB stab, BOOLEAN *eflg)
56 {
57 if (prog_trace) {
58 trace_out("%d: ", iline(node)+1);
59 trace_pnode(node);
60 trace_endl();
61 }
62 if (iistype(node, IIDENT))
63 return evaluate_iden(node, stab, eflg);
64 if (iistype(node, IBCALL))
65 return evaluate_func(node, stab, eflg);
66 if (iistype(node, IFCALL))
67 return evaluate_ufunc(node, stab, eflg);
68 *eflg = FALSE;
69 if (iistype(node, IICONS))
70 return copy_pvalue(node->vars.iicons.value);
71 if (iistype(node, ISCONS))
72 return copy_pvalue(node->vars.iscons.value);
73 if (iistype(node, IFCONS))
74 return copy_pvalue(node->vars.ifcons.value);
75 *eflg = TRUE;
76 return NULL;
77 }
78 /*====================================+
79 * trace_out -- output report trace info
80 *===================================*/
81 void
trace_out(STRING fmt,...)82 trace_out (STRING fmt, ...)
83 {
84 va_list args;
85 va_start(args, fmt);
86 trace_outv(fmt, args);
87 va_end(args);
88 }
89 /*====================================+
90 * trace_outv -- output report trace info
91 *===================================*/
92 static void
trace_outv(STRING fmt,va_list args)93 trace_outv (STRING fmt, va_list args)
94 {
95 llvwprintf(fmt, args);
96 }
97 /*====================================+
98 * trace_outl -- output report trace info & line end
99 *===================================*/
100 void
trace_outl(STRING fmt,...)101 trace_outl (STRING fmt, ...)
102 {
103 va_list args;
104 va_start(args, fmt);
105 trace_outv(fmt, args);
106 va_end(args);
107 trace_endl();
108 }
109 /*====================================+
110 * trace_pvalue -- Send pvalue to trace output
111 *===================================*/
112 void
trace_pvalue(PVALUE val)113 trace_pvalue (PVALUE val)
114 {
115 show_pvalue(val);
116 }
117 /*====================================+
118 * trace_pnode -- Send pnode to trace output
119 *===================================*/
120 void
trace_pnode(PNODE node)121 trace_pnode (PNODE node)
122 {
123 debug_show_one_pnode(node);
124 }
125 /*====================================+
126 * trace_endl -- Finish trace line
127 *===================================*/
128 void
trace_endl(void)129 trace_endl (void)
130 {
131 llwprintf("\n");
132 }
133 /*====================================+
134 * evaluate_iden -- Evaluate identifier
135 * makes & returns copy
136 *===================================*/
137 PVALUE
evaluate_iden(PNODE node,SYMTAB stab,BOOLEAN * eflg)138 evaluate_iden (PNODE node, SYMTAB stab, BOOLEAN *eflg)
139 {
140 CNSTRING iden = iident_name(node);
141 if (prog_trace)
142 trace_outl("evaluate_iden called: iden = %s", iden);
143 *eflg = FALSE;
144 return valueof_iden(node, stab, iden, eflg);
145 }
146 /*=======================================+
147 * valueof_iden - Find value of identifier
148 * makes & returns copy
149 *======================================*/
150 PVALUE
valueof_iden(PNODE node,SYMTAB stab,CNSTRING iden,BOOLEAN * eflg)151 valueof_iden (PNODE node, SYMTAB stab, CNSTRING iden, BOOLEAN *eflg)
152 {
153 BOOLEAN there;
154 PVALUE val;
155
156 #ifdef DEBUG
157 llwprintf("valueof_iden: iden, stab, globtab: %s, %d, %d\n",
158 iden, stab, globtab);
159 #endif
160
161 *eflg = FALSE;
162 val = symtab_valueofbool(stab, iden, &there);
163 if (there) return copy_pvalue(val);
164 val = symtab_valueofbool(globtab, iden, &there);
165 if (there) return copy_pvalue(val);
166 /* undeclared identifier */
167 if (explicitvars) {
168 *eflg = TRUE;
169 prog_error(node, "Undeclared identifier: %s", iden);
170 }
171 return create_pvalue_any();
172 }
173 /*================================================+
174 * evaluate_cond -- Evaluate conditional expression
175 *===============================================*/
176 BOOLEAN
evaluate_cond(PNODE node,SYMTAB stab,BOOLEAN * eflg)177 evaluate_cond (PNODE node, SYMTAB stab, BOOLEAN *eflg)
178 {
179 PVALUE val;
180 BOOLEAN rc;
181 PNODE var = node, expr = inext(node);
182 if (!expr) {
183 expr = var;
184 var = NULL;
185 }
186 if (var && !iistype(var, IIDENT)) {
187 *eflg = TRUE;
188 prog_error(node, "1st arg in conditional must be variable");
189 return FALSE;
190 }
191 val = evaluate(expr, stab, eflg);
192 if (*eflg || !val) {
193 *eflg = TRUE;
194 prog_error(node, "error in conditional expression");
195 return FALSE;
196 }
197 #ifdef DEBUG
198 llwprintf("interp_if: cond = ");
199 show_pvalue(val);
200 wprintf("\n");
201 #endif
202 if (var) assign_iden(stab, iident_name(node), copy_pvalue(val));
203 coerce_pvalue(PBOOL, val, eflg);
204 rc = pvalue_to_bool(val);
205 delete_pvalue(val);
206 return rc;
207 }
208 /*==========================================+
209 * evaluate_func -- Evaluate builtin function
210 *=========================================*/
211 PVALUE
evaluate_func(PNODE node,SYMTAB stab,BOOLEAN * eflg)212 evaluate_func (PNODE node, SYMTAB stab, BOOLEAN *eflg)
213 {
214 PVALUE val;
215
216 *eflg = FALSE;
217 if (prog_trace)
218 trace_outl("evaluate_func called: %d: %s",
219 iline(node)+1, iname(node));
220 val = (*(PFUNC)ifunc(node))(node, stab, eflg);
221 return val;
222 }
223 /*================================================+
224 * evaluate_ufunc -- Evaluate user defined function
225 * node: [in] parsed node of function definition
226 * stab: [in] function's symbol table
227 * eflg: [out] error flag
228 *===============================================*/
229 PVALUE
evaluate_ufunc(PNODE node,SYMTAB stab,BOOLEAN * eflg)230 evaluate_ufunc (PNODE node, SYMTAB stab, BOOLEAN *eflg)
231 {
232 STRING procname = (STRING) iname(node);
233 PNODE func=0, argvar=0, parm=0;
234 SYMTAB newstab = NULL;
235 PVALUE val=NULL;
236 INTERPTYPE irc=0;
237 INT count=0;
238
239 *eflg = TRUE;
240 /* find func in local or global table */
241 func = get_proc_node(procname, irptinfo(node)->functab, gfunctab, &count);
242 if (!func) {
243 if (!count)
244 prog_error(node, _("Undefined func: %s"), procname);
245 else
246 prog_error(node, _("Ambiguous call to func: %s"), procname);
247 goto ufunc_leave;
248 }
249
250 newstab = create_symtab_proc(procname, stab);
251 argvar = ifcall_args(node); /* instance values */
252 parm = ifdefn_args(func);
253 while (argvar && parm) {
254 BOOLEAN eflg=TRUE;
255 PVALUE value = evaluate(argvar, stab, &eflg);
256 if (eflg) {
257 if (getlloptint("FullReportCallStack", 0) > 0)
258 prog_error(node, "In user function %s()", procname);
259 return INTERROR;
260 }
261 insert_symtab(newstab, iident_name(parm), value);
262 argvar = inext(argvar);
263 parm = inext(parm);
264 }
265 if (argvar || parm) {
266 prog_error(node, "``%s'': mismatched args and params\n", procname);
267 goto ufunc_leave;
268 }
269 irc = interpret((PNODE) ibody(func), newstab, &val);
270 switch (irc) {
271 case INTRETURN:
272 case INTOKAY:
273 #ifdef DEBUG
274 llwprintf("Successful ufunc call -- val returned was ");
275 show_pvalue(val);
276 llwprintf("\n");
277 #endif
278 *eflg = FALSE;
279 goto ufunc_leave;
280 case INTBREAK:
281 case INTCONTINUE:
282 case INTERROR:
283 break;
284 }
285 if (getlloptint("FullReportCallStack", 0) > 0)
286 prog_error(node, "In user function %s()", procname);
287 *eflg = TRUE;
288 delete_pvalue(val);
289 val=NULL;
290
291 ufunc_leave:
292 if (newstab) {
293 remove_symtab(newstab);
294 newstab = NULL;
295 }
296 return val;
297 }
298 /*=====================================
299 * iistype -- Check type of interp node
300 *===================================*/
301 BOOLEAN
iistype(PNODE node,INT type)302 iistype (PNODE node,
303 INT type)
304 {
305 return itype(node) == type;
306 }
307 /*==============================================
308 * num_params -- Return number of params in list
309 *============================================*/
310 INT
num_params(PNODE node)311 num_params (PNODE node)
312 {
313 INT np = 0;
314 while (node) {
315 np++;
316 node = inext(node);
317 }
318 return np;
319 }
320 /*============================================
321 * assign_iden -- Assign ident value in symtab
322 *==========================================*/
323 void
assign_iden(SYMTAB stab,CNSTRING id,PVALUE value)324 assign_iden (SYMTAB stab, CNSTRING id, PVALUE value)
325 {
326 SYMTAB tab = stab;
327 if (!in_symtab(stab, id) && in_symtab(globtab, id))
328 tab = globtab;
329 insert_symtab(tab, id, value);
330 return;
331 }
332 /*=================================================
333 * eval_and_coerce -- Generic evaluator and coercer
334 * type: [IN] desired pvalue type
335 * node: [IN] node to coerce
336 * stab: [IN] symbol table
337 * eflg: [OUT] error flag
338 *===============================================*/
339 PVALUE
eval_and_coerce(INT type,PNODE node,SYMTAB stab,BOOLEAN * eflg)340 eval_and_coerce (INT type, PNODE node, SYMTAB stab, BOOLEAN *eflg)
341 {
342 PVALUE val = eval_without_coerce(node, stab, eflg);
343 if (*eflg) return NULL;
344 coerce_pvalue(type, val, eflg);
345 return val;
346 }
347 /*=================================================
348 * eval_without_coerce -- Generic evaluator
349 * node: [IN] node to coerce
350 * stab: [IN] symbol table
351 * eflg: [OUT] error flag
352 * Created: 2001/12/24, Perry Rapp
353 *===============================================*/
354 PVALUE
eval_without_coerce(PNODE node,SYMTAB stab,BOOLEAN * eflg)355 eval_without_coerce (PNODE node, SYMTAB stab, BOOLEAN *eflg)
356 {
357 PVALUE val;
358 if (*eflg) return NULL;
359 val = evaluate(node, stab, eflg);
360 if (*eflg || !val) {
361 *eflg = TRUE;
362 if (val) {
363 delete_pvalue(val);
364 val=NULL;
365 }
366 return NULL;
367 }
368 return val;
369 }
370