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 /*=============================================================
25 * intrpseq.c -- Programming interface to the INDISEQ data type
26 * Copyright(c) 1992-95 by T.T. Wetmore IV; all rights reserved
27 * 2.3.4 - 24 Jun 93 2.3.5 - 21 Aug 93
28 * 3.0.2 - 11 Dec 94 3.0.3 - 08 Aug 95
29 *===========================================================*/
30
31 #include "llstdlib.h"
32 #include "table.h"
33 #include "translat.h"
34 #include "gedcom.h"
35 #include "cache.h"
36 #include "interpi.h"
37 #include "indiseq.h"
38 #include "gengedc.h"
39
40 /*********************************************
41 * local function prototypes
42 *********************************************/
43
44 static UNION pvseq_copy_value(UNION uval, INT valtype);
45 static void pvseq_delete_value(UNION uval, INT valtype);
46 static INT pvseq_compare_values(VPTR ptr1, VPTR ptr2, INT valtype);
47 static UNION pvseq_create_gen_value(INT gen, INT * valtype);
48
49 /*********************************************
50 * local variables
51 *********************************************/
52
53 static struct tag_indiseq_value_fnctable pvseq_fnctbl =
54 {
55 &pvseq_copy_value
56 , &pvseq_delete_value
57 , &pvseq_create_gen_value
58 , &pvseq_compare_values
59 };
60
61 /*********************************************
62 * local function definitions
63 * body of module
64 *********************************************/
65
66 /*======================================+
67 * llrpt_indiset -- Declare an INDISEQ variable
68 * usage: indiset(VARB) -> VOID
69 *=====================================*/
70 PVALUE
llrpt_indiset(PNODE node,SYMTAB stab,BOOLEAN * eflg)71 llrpt_indiset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
72 {
73 INDISEQ newseq=0;
74 PVALUE newval=0;
75 PNODE arg1 = builtin_args(node);
76 if (!iistype(arg1, IIDENT)) {
77 *eflg = TRUE;
78 prog_var_error(node, stab, arg1, NULL, nonvar1, "indiset");
79 return NULL;
80 }
81 *eflg = FALSE;
82 newseq = create_indiseq_pval();
83 set_indiseq_value_funcs(newseq, &pvseq_fnctbl);
84 newval = create_pvalue_from_seq(newseq);
85 assign_iden(stab, iident_name(arg1), newval);
86 /* gave val1 to stab, so don't clear it */
87 return NULL;
88 }
89 /*==================================+
90 * llrpt_addtoset -- Add person to INDISEQ
91 * usage: addtoset(SET, INDI, ANY) -> VOID
92 *=================================*/
93 PVALUE
llrpt_addtoset(PNODE node,SYMTAB stab,BOOLEAN * eflg)94 llrpt_addtoset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
95 {
96 NODE indi=0;
97 STRING key=0;
98 INDISEQ seq=0;
99 PNODE arg1 = builtin_args(node), arg2 = inext(arg1),
100 arg3 = inext(arg2);
101 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
102 PVALUE val2=0;
103 if (*eflg) {
104 prog_var_error(node, stab, arg1, val1, nonsetx, "addtoset", "1");
105 return NULL;
106 }
107 ASSERT(seq = pvalue_to_seq(val1));
108 indi = eval_indi(arg2, stab, eflg, NULL);
109 if (*eflg) {
110 prog_var_error(node, stab, arg2, NULL, nonindx, "addtoset","2");
111 goto ats_exit;
112 }
113 if (!indi) goto ats_exit;
114 *eflg = TRUE;
115 if (!(key = strsave(rmvat(nxref(indi))))) {
116 prog_error(node, "major error in addtoset.");
117 goto ats_exit;
118 }
119 *eflg = FALSE;
120 val2 = evaluate(arg3, stab, eflg);
121 if (*eflg) {
122 prog_error(node, "3rd arg to addtoset is in error.");
123 goto ats_exit;
124 }
125 append_indiseq_pval(seq, key, NULL, val2, FALSE);
126 ats_exit:
127 if (key) strfree(&key); /* append made its own copy */
128 /* delay to last minute val1 cleanup lest it is a temp owning seq,
129 eg, addtoset(ancestorset(i),j) */
130 if (val1) delete_pvalue(val1);
131 return NULL;
132 }
133 /*======================================+
134 * llrpt_lengthset -- Find length of an INDISEQ
135 * usage: lengthset(SET) -> INT
136 * Implementation Detail:
137 * - implemented using llrpt_length(), which
138 * was changed to accept LISTs, SETs
139 * and TABLEs
140 * - this function is DEPRECATED
141 *=====================================*/
142 PVALUE
llrpt_lengthset(PNODE node,SYMTAB stab,BOOLEAN * eflg)143 llrpt_lengthset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
144 {
145 return llrpt_length(node, stab, eflg);
146 }
147 /*====================================+
148 * llrpt_inset -- See if person is in INDISEQ
149 * usage: inset(SET, INDI) -> BOOL
150 *==========================================*/
151 PVALUE
llrpt_inset(PNODE node,SYMTAB stab,BOOLEAN * eflg)152 llrpt_inset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
153 {
154 NODE indi;
155 STRING key=0;
156 INDISEQ seq;
157 BOOLEAN rel;
158 PNODE arg1 = builtin_args(node), arg2 = inext(arg1);
159 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
160 PVALUE valr=0;
161 if (*eflg ||!val1 || !(seq = pvalue_to_seq(val1))) {
162 *eflg = TRUE;
163 prog_var_error(node, stab, arg1, val1, nonsetx, "inset", "1");
164 goto inset_exit;
165 }
166 indi = eval_indi(arg2, stab, eflg, NULL);
167 if (*eflg) {
168 prog_var_error(node, stab, arg2, NULL, nonindx, "inset", "2");
169 goto inset_exit;
170 }
171 if (!indi) {
172 rel = FALSE;
173 } else {
174 if (!(key = strsave(rmvat(nxref(indi))))) {
175 *eflg = TRUE;
176 prog_error(node, "major error in inset.");
177 goto inset_exit;
178 }
179 rel = in_indiseq(seq, key);
180 }
181 valr = create_pvalue_from_bool(rel);
182 inset_exit:
183 /* delay delete of val1 to last minute lest it is a temp owning seq,
184 eg, inset(ancestorset(i),j) */
185 if (val1) delete_pvalue(val1);
186 if (key) strfree(&key);
187 return valr;
188 }
189 /*===========================================+
190 * llrpt_deletefromset -- Remove person from INDISEQ
191 * usage: deletefromset(SET, INDI, BOOL) -> VOID
192 *==========================================*/
193 PVALUE
llrpt_deletefromset(PNODE node,SYMTAB stab,BOOLEAN * eflg)194 llrpt_deletefromset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
195 {
196 NODE indi;
197 STRING key=0;
198 BOOLEAN all, rc;
199 INDISEQ seq;
200 PNODE arg1 = builtin_args(node), arg2 = inext(arg1),
201 arg3 = inext(arg2);
202 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
203 PVALUE val3=0;
204 if (*eflg) {
205 prog_var_error(node, stab, arg1, val1, nonsetx, "deletefromset", "1");
206 goto dfs_exit;
207 }
208 ASSERT(seq = pvalue_to_seq(val1));
209 indi = eval_indi(arg2, stab, eflg, NULL);
210 if (*eflg) {
211 prog_var_error(node, stab, arg2, NULL, nonindx, "deletefromset", "2");
212 goto dfs_exit;
213 }
214 if (!indi) goto dfs_exit;
215 *eflg = TRUE;
216 if (!(key = strsave(rmvat(nxref(indi))))) {
217 prog_error(node, "major error in deletefromset.");
218 goto dfs_exit;
219 }
220 *eflg = FALSE;
221 val3 = eval_and_coerce(PBOOL, arg3, stab, eflg);
222 if (*eflg) {
223 prog_var_error(node, stab, arg2, NULL, nonboox, "deletefromset", "3");
224 goto dfs_exit;
225 }
226 all = pvalue_to_bool(val3);
227 delete_pvalue(val3);
228 do {
229 rc = delete_indiseq(seq, key, NULL, 0);
230 } while (rc && all);
231 dfs_exit:
232 /* delay delete of val1 to last minute lest it is a temp owning seq,
233 eg, deletefromset(ancestorset(i),j) */
234 if (val1) delete_pvalue(val1);
235 if (key) strfree(&key);
236 return NULL;
237 }
238 /*================================+
239 * llrpt_namesort -- Sort INDISEQ by name
240 * usage: namesort(SET) -> VOID
241 *===============================*/
242 PVALUE
llrpt_namesort(PNODE node,SYMTAB stab,BOOLEAN * eflg)243 llrpt_namesort (PNODE node, SYMTAB stab, BOOLEAN *eflg)
244 {
245 INDISEQ seq;
246 PNODE arg1 = builtin_args(node);
247 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
248 if (*eflg) {
249 prog_var_error(node, stab, arg1, val1, nonset1, "namesort");
250 return NULL;
251 }
252 ASSERT(seq = pvalue_to_seq(val1));
253 namesort_indiseq(seq);
254 /* delay to last minute lest it is a temp owning seq,
255 eg, namesort(ancestorset(i) */
256 delete_pvalue(val1);
257 return NULL;
258 }
259 /*==============================+
260 * llrpt_keysort -- Sort INDISEQ by key
261 * usage: keysort(SET) -> VOID
262 *=============================*/
263 PVALUE
llrpt_keysort(PNODE node,SYMTAB stab,BOOLEAN * eflg)264 llrpt_keysort (PNODE node, SYMTAB stab, BOOLEAN *eflg)
265 {
266 INDISEQ seq;
267 PNODE arg1 = builtin_args(node);
268 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
269 if (*eflg) {
270 prog_var_error(node, stab, arg1, val1, nonset1, "namesort");
271 return NULL;
272 }
273 ASSERT(seq = pvalue_to_seq(val1));
274 keysort_indiseq(seq);
275 /* delay to last minute lest it is a temp owning seq,
276 eg, keysort(ancestorset(i) */
277 delete_pvalue(val1);
278 return NULL;
279 }
280 /*===================================
281 * llrpt_valuesort -- Sort INDISEQ by value
282 * usage: valuesort(SET) -> VOID
283 *=================================*/
284 PVALUE
llrpt_valuesort(PNODE node,SYMTAB stab,BOOLEAN * eflg)285 llrpt_valuesort (PNODE node, SYMTAB stab, BOOLEAN *eflg)
286 {
287 INDISEQ seq;
288 PNODE arg1 = builtin_args(node);
289 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
290 if (*eflg) {
291 prog_var_error(node, stab, arg1, val1, nonset1, "valuesort");
292 return NULL;
293 }
294 ASSERT(seq = pvalue_to_seq(val1));
295 valuesort_indiseq(seq,eflg);
296 if (*eflg) {
297 prog_error(node, _("missing or incorrect value for sort"));
298 return NULL;
299 }
300 /* delay to last minute lest it is a temp owning seq,
301 eg, valuesort(ancestorset(i) */
302 delete_pvalue(val1);
303 return NULL;
304 }
305 /*=========================================+
306 * llrpt_uniqueset -- Eliminate dupes from INDISEQ
307 * usage: uniqueset(SET) -> VOID
308 *========================================*/
309 PVALUE
llrpt_uniqueset(PNODE node,SYMTAB stab,BOOLEAN * eflg)310 llrpt_uniqueset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
311 {
312 INDISEQ seq=0;
313 PNODE arg1 = builtin_args(node);
314 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
315 if (*eflg) {
316 prog_var_error(node, stab, arg1, val1, nonset1, "uniqueset");
317 return NULL;
318 }
319 ASSERT(seq = pvalue_to_seq(val1));
320 unique_indiseq(seq);
321 /* delay to last minute lest it is a temp owning seq,
322 eg, uniqueset(ancestorset(i) */
323 delete_pvalue(val1);
324 return NULL;
325 }
326 /*=====================================+
327 * llrpt_union -- Create union of two INDISEQs
328 * usage: union(SET, SET) -> SET
329 *====================================*/
330 PVALUE
llrpt_union(PNODE node,SYMTAB stab,BOOLEAN * eflg)331 llrpt_union (PNODE node, SYMTAB stab, BOOLEAN *eflg)
332 {
333 PNODE arg1 = builtin_args(node);
334 PNODE arg2 = inext(arg1);
335 INDISEQ op2=0, op1=0;
336 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
337 PVALUE val2=0;
338 if (*eflg) {
339 prog_var_error(node, stab, arg1, val1, nonsetx, "union", "1");
340 return NULL;
341 }
342 /* NULL indiseqs are possible, because of getindiset */
343 op1 = pvalue_to_seq(val1);
344 val2 = eval_and_coerce(PSET, arg2, stab, eflg);
345 if (*eflg) {
346 prog_var_error(node, stab, arg2, val2, nonsetx, "union", "2");
347 return NULL;
348 }
349 op2 = pvalue_to_seq(val2);
350 op2 = union_indiseq(op1, op2);
351 set_pvalue_seq(val1, op2);
352 /* delay to last minute lest it is a temp owning seq,
353 eg, intersect(ancestorset(i),ancestorset(j)) */
354 delete_pvalue(val2);
355 return val1;
356 }
357 /*================================================+
358 * llrpt_intersect -- Create intersection of two INDISEQs
359 * usage: intersect(SET, SET) -> SET
360 *===============================================*/
361 PVALUE
llrpt_intersect(PNODE node,SYMTAB stab,BOOLEAN * eflg)362 llrpt_intersect (PNODE node, SYMTAB stab, BOOLEAN *eflg)
363 {
364 PNODE arg1 = builtin_args(node);
365 PNODE arg2 = inext(arg1);
366 INDISEQ op2=0, op1=0;
367 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
368 PVALUE val2=0;
369 if (*eflg) {
370 prog_var_error(node, stab, arg1, val1, nonsetx, "intersect", "1");
371 return NULL;
372 }
373 /* NULL indiseqs are possible, because of getindiset */
374 op1 = pvalue_to_seq(val1);
375 val2 = eval_and_coerce(PSET, arg2, stab, eflg);
376 if (*eflg) {
377 prog_var_error(node, stab, arg2, val2, nonsetx, "intersect", "2");
378 return NULL;
379 }
380 op2 = pvalue_to_seq(val2);
381 /* do actual interset */
382 op2 = intersect_indiseq(op1, op2);
383 set_pvalue_seq(val1, op2);
384 /* delay to last minute lest it is a temp owning seq,
385 eg, intersect(ancestorset(i),ancestorset(j)) */
386 delete_pvalue(val2);
387 return val1;
388 }
389 /*===============================================+
390 * llrpt_difference -- Create difference of two INDISEQs
391 * usage: difference(SET, SET) -> SET
392 *==============================================*/
393 PVALUE
llrpt_difference(PNODE node,SYMTAB stab,BOOLEAN * eflg)394 llrpt_difference (PNODE node, SYMTAB stab, BOOLEAN *eflg)
395 {
396 PNODE arg1 = builtin_args(node);
397 PNODE arg2 = inext(arg1);
398 INDISEQ op2=0, op1=0;
399 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
400 PVALUE val2=0;
401 if (*eflg) {
402 prog_var_error(node, stab, arg1, val1, nonsetx, "difference", "1");
403 return NULL;
404 }
405 /* NULL indiseqs are possible, because of getindiset */
406 op1 = pvalue_to_seq(val1);
407 val2 = eval_and_coerce(PSET, arg2, stab, eflg);
408 if (*eflg) {
409 prog_var_error(node, stab, arg2, val2, nonsetx, "difference", "2");
410 return NULL;
411 }
412 op2 = pvalue_to_seq(val2);
413 /* do actual difference */
414 op2 = difference_indiseq(op1, op2);
415 set_pvalue_seq(val1, op2);
416 /* delay to last minute lest it is a temp owning seq,
417 eg, difference(ancestorset(i),ancestorset(j)) */
418 delete_pvalue(val2);
419 return val1;
420 }
421 /*=========================================+
422 * llrpt_parentset -- Create parent set of INDISEQ
423 * usage: parentset(SET) -> SET
424 *========================================*/
425 PVALUE
llrpt_parentset(PNODE node,SYMTAB stab,BOOLEAN * eflg)426 llrpt_parentset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
427 {
428 INDISEQ seq=0;
429 PNODE arg1 = builtin_args(node);
430 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
431 if (*eflg) {
432 prog_var_error(node, stab, arg1, val1, nonset1, "parentset");
433 return NULL;
434 }
435 /* NULL indiseqs are possible, because of getindiset */
436 seq = pvalue_to_seq(val1);
437 /* do actual construction of parent set */
438 seq = parent_indiseq(seq);
439 set_pvalue_seq(val1, seq);
440 return val1;
441 }
442 /*==========================================+
443 * llrpt_childset -- Create child set of an INDISEQ
444 * usage: childset(SET) -> SET
445 *=========================================*/
446 PVALUE
llrpt_childset(PNODE node,SYMTAB stab,BOOLEAN * eflg)447 llrpt_childset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
448 {
449 INDISEQ seq=0;
450 PNODE arg1 = builtin_args(node);
451 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
452 if (*eflg) {
453 prog_var_error(node, stab, arg1, val1, nonset1, "childset");
454 return NULL;
455 }
456 ASSERT(seq = pvalue_to_seq(val1));
457 /* do actual construction of child set */
458 seq = child_indiseq(seq);
459 set_pvalue_seq(val1, seq);
460 return val1;
461 }
462 /*==============================================+
463 * llrpt_siblingset -- Create sibling set of an INDISEQ
464 * usage: siblingset(SET) -> SET
465 *=============================================*/
466 PVALUE
llrpt_siblingset(PNODE node,SYMTAB stab,BOOLEAN * eflg)467 llrpt_siblingset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
468 {
469 INDISEQ seq=0;
470 PNODE arg1 = builtin_args(node);
471 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
472 if (*eflg) {
473 prog_var_error(node, stab, arg1, val1, nonset1, "siblingset");
474 return NULL;
475 }
476 ASSERT(seq = pvalue_to_seq(val1));
477 seq = sibling_indiseq(seq, FALSE);
478 set_pvalue_seq(val1, seq);
479 return val1;
480 }
481 /*============================================+
482 * llrpt_spouseset -- Create spouse set of an INDISEQ
483 * usage: spouseset(SET) -> SET
484 *===========================================*/
485 PVALUE
llrpt_spouseset(PNODE node,SYMTAB stab,BOOLEAN * eflg)486 llrpt_spouseset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
487 {
488 INDISEQ seq=0;
489 PNODE arg1 = builtin_args(node);
490 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
491 if (*eflg) {
492 prog_var_error(node, stab, arg1, val1, nonset1, "spouseset");
493 return NULL;
494 }
495 ASSERT(seq = pvalue_to_seq(val1));
496 seq = spouse_indiseq(seq);
497 set_pvalue_seq(val1, seq);
498 return val1;
499 }
500 /*================================================+
501 * llrpt_ancestorset -- Create ancestor set of an INDISEQ
502 * usage: ancestorset(SET) -> SET
503 *===============================================*/
504 PVALUE
llrpt_ancestorset(PNODE node,SYMTAB stab,BOOLEAN * eflg)505 llrpt_ancestorset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
506 {
507 INDISEQ seq=0;
508 PNODE arg1 = builtin_args(node);
509 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
510 if (*eflg) {
511 prog_var_error(node, stab, arg1, val1, nonset1, "ancestorset");
512 return NULL;
513 }
514 ASSERT(seq = pvalue_to_seq(val1));
515 seq = ancestor_indiseq(seq);
516 set_pvalue_seq(val1, seq);
517 return val1;
518 }
519 /*====================================================+
520 * llrpt_descendentset -- Create descendent set of an INDISEQ
521 * usage: descendantset(SET) -> SET
522 *===================================================*/
523 PVALUE
llrpt_descendentset(PNODE node,SYMTAB stab,BOOLEAN * eflg)524 llrpt_descendentset (PNODE node, SYMTAB stab, BOOLEAN *eflg)
525 {
526 INDISEQ seq=0;
527 PNODE arg1 = builtin_args(node);
528 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
529 if (*eflg) {
530 prog_var_error(node, stab, arg1, val1, nonset1, "descendentset");
531 return NULL;
532 }
533 ASSERT(seq = pvalue_to_seq(val1));
534 seq = descendent_indiseq(seq);
535 set_pvalue_seq(val1, seq);
536 return val1;
537 }
538 /*===================================================+
539 * llrpt_gengedcom -- Generate GEDCOM output from an INDISEQ
540 * usage: gengedcom(SET) -> VOID
541 *==================================================*/
542 PVALUE
llrpt_gengedcom(PNODE node,SYMTAB stab,BOOLEAN * eflg)543 llrpt_gengedcom (PNODE node, SYMTAB stab, BOOLEAN *eflg)
544 {
545 INDISEQ seq=0;
546 PNODE arg1 = builtin_args(node);
547 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
548 if (*eflg) {
549 prog_var_error(node, stab, arg1, val1, nonset1, "gengedcom");
550 return NULL;
551 }
552 ASSERT(seq = pvalue_to_seq(val1));
553 gen_gedcom(seq, GENGEDCOM_ORIGINAL, eflg);
554 /* delay to last minute lest it is a temp owning seq,
555 eg, gengedcom(ancestorset(i)) */
556 delete_pvalue(val1);
557 return NULL;
558 }
559
560 /*===================================================+
561 * llrpt_gengedcomweak -- Generate GEDCOM output from an INDISEQ
562 * usage: gengedcom(SET) -> VOID
563 * Perry 2000/11/03
564 *==================================================*/
565 PVALUE
llrpt_gengedcomweak(PNODE node,SYMTAB stab,BOOLEAN * eflg)566 llrpt_gengedcomweak (PNODE node, SYMTAB stab, BOOLEAN *eflg)
567 {
568 INDISEQ seq=0;
569 PNODE arg1 = builtin_args(node);
570 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
571 if (*eflg) {
572 prog_var_error(node, stab, arg1, val1, nonset1, "gengedcomweak");
573 return NULL;
574 }
575 ASSERT(seq = pvalue_to_seq(val1));
576 gen_gedcom(seq, GENGEDCOM_WEAK_DUMP, eflg);
577 /* delay to last minute lest it is a temp owning seq,
578 eg, gengedcom(ancestorset(i)) */
579 delete_pvalue(val1);
580 return NULL;
581 }
582
583 /*===================================================+
584 * llrpt_gengedcomstrong -- Generate GEDCOM output from an INDISEQ
585 * usage: gengedcom(SET) -> VOID
586 * Perry 2000/11/03
587 *==================================================*/
588 PVALUE
llrpt_gengedcomstrong(PNODE node,SYMTAB stab,BOOLEAN * eflg)589 llrpt_gengedcomstrong (PNODE node, SYMTAB stab, BOOLEAN *eflg)
590 {
591 INDISEQ seq=0;
592 PNODE arg1 = builtin_args(node);
593 PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg);
594 if (*eflg) {
595 prog_var_error(node, stab, arg1, val1, nonset1, "gengedcomstrong");
596 return NULL;
597 }
598 ASSERT(seq = pvalue_to_seq(val1));
599 gen_gedcom(seq, GENGEDCOM_STRONG_DUMP, eflg);
600 /* delay to last minute lest it is a temp owning seq,
601 eg, gengedcom(ancestorset(i)) */
602 delete_pvalue(val1);
603 return NULL;
604 }
605 /*=====================================+
606 * pvseq_copy_value -- Copy PVALUE in an INDISEQ
607 * Created: 2001/03/25, Perry Rapp
608 *====================================*/
609 static UNION
pvseq_copy_value(UNION uval,INT valtype)610 pvseq_copy_value (UNION uval, INT valtype)
611 {
612 UNION retval;
613 PVALUE val = (PVALUE)uval.w;
614 ASSERT(valtype == ISVAL_PTR || valtype == ISVAL_NUL);
615 ASSERT(is_pvalue(val) || !val);
616 retval.w = copy_pvalue(val);
617 return retval;
618 }
619 /*=====================================+
620 * pvseq_delete_value -- Delete a PVALUE in an INDISEQ
621 * Created: 2001/03/25, Perry Rapp
622 *====================================*/
623 static void
pvseq_delete_value(UNION uval,INT valtype)624 pvseq_delete_value (UNION uval, INT valtype)
625 {
626 PVALUE val = (PVALUE)uval.w;
627 ASSERT(valtype == ISVAL_PTR || valtype == ISVAL_NUL);
628 ASSERT(is_pvalue(val) || !val);
629 delete_pvalue(val);
630 }
631 /*=====================================+
632 * pvseq_create_gen_value -- Create a PVALUE
633 * for a specific generation in an ancestor
634 * or descendant set in an INDISEQ
635 * Assumes seq is NUL or PTR type
636 * Created: 2001/03/25, Perry Rapp
637 *====================================*/
638 static UNION
pvseq_create_gen_value(INT gen,INT * valtype)639 pvseq_create_gen_value (INT gen, INT * valtype)
640 {
641 UNION uval;
642 ASSERT(*valtype == ISVAL_PTR || *valtype == ISVAL_NUL);
643 *valtype = ISVAL_PTR;
644 uval.w = create_pvalue_from_int(gen);
645 return uval;
646 }
647 /*=============================================
648 * pvseq_compare_values -- Compare two pvalues
649 * for sorting (collation) of an indiset
650 *============================================*/
651 static INT
pvseq_compare_values(VPTR ptr1,VPTR ptr2,INT valtype)652 pvseq_compare_values (VPTR ptr1, VPTR ptr2, INT valtype)
653 {
654 PVALUE val1=ptr1, val2=ptr2;
655 ASSERT(valtype == ISVAL_PTR || valtype == ISVAL_NUL);
656 if (valtype == ISVAL_NUL)
657 return 0;
658 return pvalues_collate(val1, val2);
659 }
660