1 /*********************************************
2   File:     core_tries.c
3   Author:   Ricardo Rocha
4   Comments: Tries core module for Yap Prolog
5   version:  $ID$
6 *********************************************/
7 
8 
9 
10 /* -------------------------- */
11 /*          Includes          */
12 /* -------------------------- */
13 
14 #include <YapInterface.h>
15 #include <stdio.h>
16 #include <stdlib.h>
17 #include <string.h>
18 #include "core_tries.h"
19 
20 
21 
22 /* -------------------------- */
23 /*      Local Procedures      */
24 /* -------------------------- */
25 
26 static TrNode   put_entry(TrNode node, YAP_Term entry);
27 static TrNode   check_entry(TrNode node, YAP_Term entry);
28 static YAP_Term get_entry(TrNode node, YAP_Term *stack_list, TrNode *cur_node);
29 static void     remove_entry(TrNode node);
30 static void     remove_child_nodes(TrNode node);
31 static TrNode   copy_child_nodes(TrNode parent_dest, TrNode node_source);
32 static void     traverse_and_add(TrNode parent_dest, TrNode parent_source);
33 static void     traverse_and_join(TrNode parent_dest, TrNode parent_source);
34 static void     traverse_and_intersect(TrNode parent_dest, TrNode parent_source);
35 static YAP_Int  traverse_and_count_common_entries(TrNode parent1, TrNode parent2);
36 static YAP_Int  traverse_and_count_entries(TrNode node);
37 static void     traverse_and_get_usage(TrNode node, YAP_Int depth);
38 static void     traverse_and_save(TrNode node, FILE *file, int float_block);
39 static void     traverse_and_load(TrNode parent, FILE *file);
40 static void     traverse_and_print(TrNode node, int *arity, char *str, int str_index, int mode);
41 
42 static YAP_Term trie_to_list(TrNode node);
43 static YAP_Term trie_to_list_node(TrNode node);
44 static YAP_Term trie_to_list_floats(TrNode node);
45 
46 
47 /* -------------------------- */
48 /*       Local Variables      */
49 /* -------------------------- */
50 
51 static TrEngine CURRENT_TRIE_ENGINE;
52 static YAP_Int USAGE_ENTRIES, USAGE_NODES, USAGE_VIRTUAL_NODES;
53 static YAP_Int CURRENT_AUXILIARY_TERM_STACK_SIZE, CURRENT_TRIE_MODE, CURRENT_LOAD_VERSION, CURRENT_DEPTH, CURRENT_INDEX;
54 static YAP_Term *AUXILIARY_TERM_STACK;
55 static YAP_Term *stack_args, *stack_args_base, *stack_vars, *stack_vars_base;
56 static YAP_Functor FunctorComma;
57 static void (*DATA_SAVE_FUNCTION)(TrNode, FILE *);
58 static void (*DATA_LOAD_FUNCTION)(TrNode, YAP_Int, FILE *);
59 static void (*DATA_PRINT_FUNCTION)(TrNode);
60 static void (*DATA_ADD_FUNCTION)(TrNode, TrNode);
61 static void (*DATA_COPY_FUNCTION)(TrNode, TrNode);
62 static void (*DATA_DESTRUCT_FUNCTION)(TrNode);
63 
64 static YAP_Int TRIE_DISABLE_HASH_TABLE = 0;
65 
66 
67 /* -------------------------- */
68 /*     Inline Procedures      */
69 /* -------------------------- */
70 
71 static inline
trie_node_check_insert(TrNode parent,YAP_Term t)72 TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
73   TrNode child;
74 
75   CURRENT_DEPTH++;
76   child = TrNode_child(parent);
77   if (child == NULL) {
78     new_trie_node(child, t, parent, NULL, NULL, NULL);
79     TrNode_child(parent) = child;
80   } else if (IS_HASH_NODE(child)) {
81     TrHash hash;
82     TrNode *bucket;
83     int count;
84     hash = (TrHash) child;
85     bucket = TrHash_bucket(hash, HASH_TERM(t, TrHash_seed(hash)));
86     child = *bucket;
87     count = 0;
88     while (child) {
89       if ((TrNode_entry(child) == t) || (((TrNode_entry(child) == PairEndTermTag) || (TrNode_entry(child) == PairEndEmptyTag)) && ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL)))
90         return child;
91       count++;
92       child = TrNode_next(child);
93     } while (child);
94     TrHash_num_nodes(hash)++;
95     new_trie_node(child, t, parent, NULL, *bucket, AS_TR_NODE_NEXT(bucket));
96     if (*bucket)
97       TrNode_previous(*bucket) = child;
98     *bucket = child;
99     if (count > MAX_NODES_PER_BUCKET && TrHash_num_nodes(hash) > TrHash_num_buckets(hash)) {
100       /* expand trie hash */
101       TrNode chain, next, *first_bucket, *new_bucket;
102       int seed;
103       first_bucket = TrHash_buckets(hash);
104       bucket = first_bucket + TrHash_num_buckets(hash);
105       TrHash_num_buckets(hash) *= 2;
106       new_hash_buckets(hash, TrHash_num_buckets(hash));
107       seed = TrHash_num_buckets(hash) - 1;
108       do {
109         if (*--bucket) {
110           chain = *bucket;
111           do {
112             new_bucket = TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), seed));
113             next = TrNode_next(chain);
114             TrNode_next(chain) = *new_bucket;
115             TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket);
116             if (*new_bucket)
117               TrNode_previous(*new_bucket) = chain;
118             *new_bucket = chain;
119             chain = next;
120           } while (chain);
121         }
122       } while (bucket != first_bucket);
123       free_hash_buckets(first_bucket, TrHash_num_buckets(hash) / 2);
124     }
125   } else {
126     int count = 0;
127     do {
128       if ((TrNode_entry(child) == t) || (((TrNode_entry(child) == PairEndTermTag) || (TrNode_entry(child) == PairEndEmptyTag)) && ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL)))
129         return child;
130       count++;
131       child = TrNode_next(child);
132     } while (child);
133     new_trie_node(child, t, parent, NULL, TrNode_child(parent), NULL);
134     TrNode_previous(TrNode_child(parent)) = child;
135     if ((++count > MAX_NODES_PER_TRIE_LEVEL) && (TRIE_DISABLE_HASH_TABLE == 0)) {
136       /* alloc a new trie hash */
137       TrHash hash;
138       TrNode chain, next, *bucket;
139       new_trie_hash(hash, count, BASE_HASH_BUCKETS);
140       chain = child;
141       do {
142         bucket = TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), BASE_HASH_BUCKETS - 1));
143         next = TrNode_next(chain);
144         TrNode_next(chain) = *bucket;
145         TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket);
146         if (*bucket)
147           TrNode_previous(*bucket) = chain;
148         *bucket = chain;
149         chain = next;
150       } while (chain);
151       TrNode_child(parent) = (TrNode) hash;
152     } else
153       TrNode_child(parent) = child;
154   }
155   return child;
156 }
157 
158 
159 static inline
trie_node_insert(TrNode parent,YAP_Term t,TrHash hash)160 TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) {
161   TrNode child;
162 
163   CURRENT_DEPTH++;
164   if (hash) {
165     /* is trie hash */
166     TrNode *bucket;
167     TrHash_num_nodes(hash)++;
168     bucket = TrHash_bucket(hash, HASH_TERM(t, TrHash_seed(hash)));
169     new_trie_node(child, t, parent, NULL, *bucket, AS_TR_NODE_NEXT(bucket));
170     if (*bucket)
171       TrNode_previous(*bucket) = child;
172     *bucket = child;
173   } else {
174     new_trie_node(child, t, parent, NULL, TrNode_child(parent), NULL);
175     if (TrNode_child(parent))
176       TrNode_previous(TrNode_child(parent)) = child;
177     TrNode_child(parent) = child;
178   }
179   return child;
180 }
181 
182 
183 static inline
trie_node_check(TrNode parent,YAP_Term t)184 TrNode trie_node_check(TrNode parent, YAP_Term t) {
185   TrNode child;
186 
187   child = TrNode_child(parent);
188   if (IS_HASH_NODE(child)) {
189     TrHash hash;
190     TrNode *bucket;
191     hash = (TrHash) child;
192     bucket = TrHash_bucket(hash, HASH_TERM(t, TrHash_seed(hash)));
193     child = *bucket;
194     if (!child)
195       return NULL;
196   }
197   do {
198     if (TrNode_entry(child) == t)
199       return child;
200     child = TrNode_next(child);
201   } while (child);
202   return NULL;
203 }
204 
205 
206 static inline
trie_to_list_create_simple(const char * atom_name,TrNode node)207 YAP_Term trie_to_list_create_simple(const char *atom_name, TrNode node) {
208   YAP_Functor f = YAP_MkFunctor(YAP_LookupAtom(atom_name), 1);
209   YAP_Term child = trie_to_list(TrNode_child(node));
210 
211   return YAP_MkApplTerm(f, 1, &child);
212 }
213 
214 
215 static inline
trie_to_list_create_simple_end(const char * atom_name,TrNode node)216 YAP_Term trie_to_list_create_simple_end(const char *atom_name, TrNode node) {
217   YAP_Atom atom = YAP_LookupAtom(atom_name);
218 
219   if (IS_LEAF_TRIE_NODE(node)) {
220     return YAP_MkAtomTerm(atom);
221   } else {
222     YAP_Functor f = YAP_MkFunctor(atom, 1);
223     YAP_Term child = trie_to_list(TrNode_child(node));
224     return YAP_MkApplTerm(f, 1, &child);
225   }
226 }
227 
228 
229 static inline
trie_to_list_create_two(const char * atom_name,TrNode node,YAP_Term operand)230 YAP_Term trie_to_list_create_two(const char *atom_name, TrNode node, YAP_Term operand) {
231   YAP_Atom atom = YAP_LookupAtom(atom_name);
232 
233   if(IS_LEAF_TRIE_NODE(node)) {
234     YAP_Functor f = YAP_MkFunctor(atom, 1);
235     return YAP_MkApplTerm(f, 1, &operand);
236   } else {
237     YAP_Functor f = YAP_MkFunctor(atom, 2);
238     YAP_Term args[2] = {
239       operand, trie_to_list(TrNode_child(node))
240     };
241     return YAP_MkApplTerm(f, 2, args);
242   }
243 }
244 
245 
246 /* -------------------------- */
247 /*            API             */
248 /* -------------------------- */
249 
250 inline
core_trie_init_module(void)251 TrEngine core_trie_init_module(void) {
252   static int init_once = 1;
253   TrEngine engine;
254 
255   if (init_once) {
256     new_struct(AUXILIARY_TERM_STACK, YAP_Term, BASE_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term));
257     CURRENT_AUXILIARY_TERM_STACK_SIZE = BASE_AUXILIARY_TERM_STACK_SIZE;
258     CURRENT_TRIE_MODE = TRIE_MODE_STANDARD;
259     FunctorComma = YAP_MkFunctor(YAP_LookupAtom(","), 2);
260     init_once = 0;
261   }
262   new_trie_engine(engine);
263   return engine;
264 }
265 
266 
267 inline
core_trie_open(TrEngine engine)268 TrNode core_trie_open(TrEngine engine) {
269   TrNode node;
270 
271   CURRENT_TRIE_ENGINE = engine;
272   new_trie_node(node, 0, NULL, NULL, TrEngine_trie(engine), AS_TR_NODE_NEXT(&TrEngine_trie(engine)));
273   if (TrEngine_trie(engine))
274     TrNode_previous(TrEngine_trie(engine)) = node;
275   TrEngine_trie(engine) = node;
276   INCREMENT_TRIES(CURRENT_TRIE_ENGINE);
277   return node;
278 }
279 
280 
281 inline
core_trie_close(TrEngine engine,TrNode node,void (* destruct_function)(TrNode))282 void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
283   CURRENT_TRIE_ENGINE = engine;
284   DATA_DESTRUCT_FUNCTION = destruct_function;
285   if (TrNode_child(node))
286     remove_child_nodes(TrNode_child(node));
287   if (TrNode_next(node)) {
288     TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
289     TrNode_next(TrNode_previous(node)) = TrNode_next(node);
290   } else
291     TrNode_next(TrNode_previous(node)) = NULL;
292   free_trie_node(node);
293   DECREMENT_TRIES(CURRENT_TRIE_ENGINE);
294   return;
295 }
296 
297 
298 inline
core_trie_close_all(TrEngine engine,void (* destruct_function)(TrNode))299 void core_trie_close_all(TrEngine engine, void (*destruct_function)(TrNode)) {
300   while (TrEngine_trie(engine))
301     core_trie_close(engine, TrEngine_trie(engine), destruct_function);
302   return;
303 }
304 
305 
306 inline
core_trie_set_mode(YAP_Int mode)307 void core_trie_set_mode(YAP_Int mode) {
308   CURRENT_TRIE_MODE = mode;
309   return;
310 }
311 
312 
313 inline
core_trie_get_mode(void)314 YAP_Int core_trie_get_mode(void) {
315   return CURRENT_TRIE_MODE;
316 }
317 
318 
319 inline
core_trie_put_entry(TrEngine engine,TrNode node,YAP_Term entry,YAP_Int * depth)320 TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int *depth) {
321   CURRENT_TRIE_ENGINE = engine;
322   CURRENT_DEPTH = 0;
323   stack_args_base = stack_args = AUXILIARY_TERM_STACK;
324   stack_vars_base = stack_vars = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
325   node = put_entry(node, entry);
326   if (!IS_LEAF_TRIE_NODE(node)) {
327     MARK_AS_LEAF_TRIE_NODE(node);
328     INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
329   }
330   /* reset var terms */
331   while (STACK_NOT_EMPTY(stack_vars++, stack_vars_base)) {
332     (void) POP_DOWN(stack_vars);
333     *((YAP_Term *)*stack_vars) = *stack_vars;
334   }
335   if (depth)
336     *depth = CURRENT_DEPTH;
337   return node;
338 }
339 
340 
341 inline
core_trie_check_entry(TrNode node,YAP_Term entry)342 TrNode core_trie_check_entry(TrNode node, YAP_Term entry) {
343   if (!TrNode_child(node))
344     return NULL;
345   stack_args_base = stack_args = AUXILIARY_TERM_STACK;
346   stack_vars_base = stack_vars = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
347   node = check_entry(node, entry);
348   /* reset var terms */
349   while (STACK_NOT_EMPTY(stack_vars++, stack_vars_base)) {
350     (void) POP_DOWN(stack_vars);
351     *((YAP_Term *)*stack_vars) = *stack_vars;
352   }
353   return node;
354 }
355 
356 
357 inline
core_trie_get_entry(TrNode node)358 YAP_Term core_trie_get_entry(TrNode node) {
359   CURRENT_INDEX = -1;
360   stack_vars_base = stack_vars = AUXILIARY_TERM_STACK;
361   stack_args_base = stack_args = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
362   return get_entry(node, stack_args, &node);
363 }
364 
365 
366 inline
core_trie_remove_entry(TrEngine engine,TrNode node,void (* destruct_function)(TrNode))367 void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
368   CURRENT_TRIE_ENGINE = engine;
369   DATA_DESTRUCT_FUNCTION = destruct_function;
370   if (DATA_DESTRUCT_FUNCTION)
371     (*DATA_DESTRUCT_FUNCTION)(node);
372   DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
373   remove_entry(node);
374   return;
375 }
376 
377 
378 inline
core_trie_remove_subtree(TrEngine engine,TrNode node,void (* destruct_function)(TrNode))379 void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
380   TrNode parent;
381 
382   CURRENT_TRIE_ENGINE = engine;
383   DATA_DESTRUCT_FUNCTION = destruct_function;
384   parent = TrNode_parent(node);
385   remove_child_nodes(TrNode_child(parent));
386   remove_entry(parent);
387   return;
388 }
389 
390 
391 inline
core_trie_add(TrNode node_dest,TrNode node_source,void (* add_function)(TrNode,TrNode))392 void core_trie_add(TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode)) {
393   DATA_ADD_FUNCTION = add_function;
394   if (TrNode_child(node_dest) && TrNode_child(node_source))
395     traverse_and_add(node_dest, node_source);
396   return;
397 }
398 
399 
400 inline
core_trie_join(TrEngine engine,TrNode node_dest,TrNode node_source,void (* add_function)(TrNode,TrNode),void (* copy_function)(TrNode,TrNode))401 void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*copy_function)(TrNode, TrNode)) {
402   CURRENT_TRIE_ENGINE = engine;
403   DATA_ADD_FUNCTION = add_function;
404   DATA_COPY_FUNCTION = copy_function;
405   if (TrNode_child(node_dest)) {
406     if (TrNode_child(node_source))
407       traverse_and_join(node_dest, node_source);
408   } else if (TrNode_child(node_source))
409     TrNode_child(node_dest) = copy_child_nodes(node_dest, TrNode_child(node_source));
410   return;
411 }
412 
413 
414 inline
core_trie_intersect(TrEngine engine,TrNode node_dest,TrNode node_source,void (* add_function)(TrNode,TrNode),void (* destruct_function)(TrNode))415 void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*destruct_function)(TrNode)) {
416   CURRENT_TRIE_ENGINE = engine;
417   DATA_ADD_FUNCTION = add_function;
418   DATA_DESTRUCT_FUNCTION = destruct_function;
419   if (TrNode_child(node_dest)) {
420     if (TrNode_child(node_source))
421       traverse_and_intersect(node_dest, node_source);
422     else {
423       remove_child_nodes(TrNode_child(node_dest));
424       TrNode_child(node_dest) = NULL;
425     }
426   }
427   return;
428 }
429 
430 
431 inline
core_trie_count_join(TrNode node1,TrNode node2)432 YAP_Int core_trie_count_join(TrNode node1, TrNode node2) {
433   YAP_Int count = 0;
434 
435   if (TrNode_child(node1)) {
436     count += traverse_and_count_entries(TrNode_child(node1));
437     if (TrNode_child(node2)) {
438       count += traverse_and_count_entries(TrNode_child(node2));
439       count -= traverse_and_count_common_entries(node1, node2);
440     }
441   } else if (TrNode_child(node2))
442     count += traverse_and_count_entries(TrNode_child(node2));
443   return count;
444 }
445 
446 
447 inline
core_trie_count_intersect(TrNode node1,TrNode node2)448 YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2) {
449   YAP_Int count = 0;
450 
451   if (TrNode_child(node1))
452     if (TrNode_child(node2))
453       count = traverse_and_count_common_entries(node1, node2);
454   return count;
455 }
456 
457 
458 inline
core_trie_save(TrNode node,FILE * file,void (* save_function)(TrNode,FILE *))459 void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE *)) {
460   CURRENT_INDEX = -1;
461   DATA_SAVE_FUNCTION = save_function;
462   if (TrNode_child(node)) {
463     fprintf(file, "BEGIN_TRIE_v2 ");
464     traverse_and_save(TrNode_child(node), file, 0);
465     fprintf(file, "END_TRIE_v2");
466   }
467   return;
468 }
469 
470 
471 inline
core_trie_load(TrEngine engine,FILE * file,void (* load_function)(TrNode,YAP_Int,FILE *))472 TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, YAP_Int, FILE *)) {
473   TrNode node;
474   char version[15];
475   fpos_t curpos;
476   int n;
477 
478   n = fscanf(file, "%14s", version);
479   if (fgetpos(file, &curpos))
480     return NULL;
481 
482   if (!strcmp(version, "BEGIN_TRIE_v2")) {
483     fseek(file, -11, SEEK_END);
484     n = fscanf(file, "%s", version);
485     if (strcmp(version, "END_TRIE_v2")) {
486       fprintf(stderr, "******************************************\n");
487       fprintf(stderr, "  Tries core module: trie file corrupted\n");
488       fprintf(stderr, "******************************************\n");
489       return NULL;
490     }
491     if (fsetpos(file, &curpos))
492       return NULL;
493     CURRENT_LOAD_VERSION = 2;
494   } else if (!strcmp(version, "BEGIN_TRIE")) {
495     fseek(file, -8, SEEK_END);
496     n = fscanf(file, "%s", version);
497     if (strcmp(version, "END_TRIE")) {
498       fprintf(stderr, "******************************************\n");
499       fprintf(stderr, "  Tries core module: trie file corrupted\n");
500       fprintf(stderr, "******************************************\n");
501       return NULL;
502     }
503     if (fsetpos(file, &curpos))
504       return NULL;
505     CURRENT_LOAD_VERSION = 1;
506   } else {
507     fprintf(stderr, "****************************************\n");
508     fprintf(stderr, "  Tries core module: invalid trie file\n");
509     fprintf(stderr, "****************************************\n");
510     return NULL;
511   }
512   CURRENT_TRIE_ENGINE = engine;
513   CURRENT_INDEX = -1;
514   CURRENT_DEPTH = 0;
515   DATA_LOAD_FUNCTION = load_function;
516   node = core_trie_open(engine);
517   traverse_and_load(node, file);
518   return node;
519 }
520 
521 
522 inline
core_trie_stats(TrEngine engine,YAP_Int * memory,YAP_Int * tries,YAP_Int * entries,YAP_Int * nodes)523 void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes) {
524   *memory = TrEngine_memory(engine);
525   *tries = TrEngine_tries(engine);
526   *entries = TrEngine_entries(engine);
527   *nodes = TrEngine_nodes(engine);
528   return;
529 }
530 
531 
532 inline
core_trie_max_stats(TrEngine engine,YAP_Int * memory,YAP_Int * tries,YAP_Int * entries,YAP_Int * nodes)533 void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes) {
534   *memory = TrEngine_memory_max(engine);
535   *tries = TrEngine_tries_max(engine);
536   *entries = TrEngine_entries_max(engine);
537   *nodes = TrEngine_nodes_max(engine);
538   return;
539 }
540 
541 
542 inline
core_trie_usage(TrNode node,YAP_Int * entries,YAP_Int * nodes,YAP_Int * virtual_nodes)543 void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *virtual_nodes) {
544   USAGE_ENTRIES = 0;
545   USAGE_NODES = 0;
546   USAGE_VIRTUAL_NODES = 0;
547   if (TrNode_child(node))
548     traverse_and_get_usage(TrNode_child(node), 0);
549   *entries = USAGE_ENTRIES;
550   *nodes = USAGE_NODES;
551   *virtual_nodes = USAGE_VIRTUAL_NODES;
552   return;
553 }
554 
555 
556 inline
core_trie_print(TrNode node,void (* print_function)(TrNode))557 void core_trie_print(TrNode node, void (*print_function)(TrNode)) {
558   DATA_PRINT_FUNCTION = print_function;
559   if (TrNode_child(node)) {
560     int arity[1000];
561     char str[10000];
562     arity[0] = 0;
563     traverse_and_print(TrNode_child(node), arity, str, 0, TRIE_PRINT_NORMAL);
564   } else
565     fprintf(stdout, "(empty)\n");
566   return;
567 }
568 
569 
570 inline
core_disable_hash_table(void)571 void core_disable_hash_table(void) {
572   TRIE_DISABLE_HASH_TABLE = 1;
573 }
574 
575 
576 inline
core_enable_hash_table(void)577 void core_enable_hash_table(void) {
578   TRIE_DISABLE_HASH_TABLE = 0;
579 }
580 
581 
582 inline
core_trie_to_list(TrNode node)583 YAP_Term core_trie_to_list(TrNode node) {
584   TrNode root = TrNode_child(node);
585 
586   if (root)
587     return trie_to_list(root);
588   else
589     return YAP_MkAtomTerm(YAP_LookupAtom("empty"));
590 }
591 
592 
593 /* -------------------------- */
594 /*      Local Procedures      */
595 /* -------------------------- */
596 
597 static
put_entry(TrNode node,YAP_Term entry)598 TrNode put_entry(TrNode node, YAP_Term entry) {
599   YAP_Term t = YAP_Deref(entry);
600   if (YAP_IsVarTerm(t)) {
601     if (IsTrieVar(t, stack_vars, stack_vars_base)) {
602       node = trie_node_check_insert(node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2));
603     } else {
604       node = trie_node_check_insert(node, MkTrieVar((stack_vars_base - stack_vars) / 2));
605       PUSH_UP(stack_vars, t, stack_args);
606       *((YAP_Term *)t) = (YAP_Term)stack_vars;
607       PUSH_UP(stack_vars, stack_vars, stack_args);
608     }
609   } else if (YAP_IsAtomTerm(t)) {
610     node = trie_node_check_insert(node, t);
611   } else if (YAP_IsIntTerm(t)) {
612     node = trie_node_check_insert(node, t);
613   } else if (YAP_IsFloatTerm(t)) {
614     volatile double f;
615     volatile YAP_Term *p;
616     f = YAP_FloatOfTerm(t);
617     p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */
618     node = trie_node_check_insert(node, FloatInitTag);
619     node = trie_node_check_insert(node, *p);
620 #ifdef TAG_LOW_BITS_32
621     node = trie_node_check_insert(node, *(p + 1));
622 #endif /* TAG_LOW_BITS_32 */
623     node = trie_node_check_insert(node, FloatEndTag);
624   } else if (YAP_IsPairTerm(t)) {
625     node = trie_node_check_insert(node, PairInitTag);
626     if ((CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) == TRIE_MODE_STANDARD) {
627       do {
628         node = put_entry(node, YAP_HeadOfTerm(t));
629         t = YAP_Deref(YAP_TailOfTerm(t));
630       } while (YAP_IsPairTerm(t));
631       if (t == YAP_TermNil()) {
632         node = trie_node_check_insert(node, PairEndEmptyTag);
633       } else {
634         node = put_entry(node, t);
635         node = trie_node_check_insert(node, PairEndTermTag);
636       }
637     } else if (CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */
638       YAP_Term *stack_list = stack_args;
639       do {
640         PUSH_DOWN(stack_args, YAP_HeadOfTerm(t), stack_vars);
641         t = YAP_Deref(YAP_TailOfTerm(t));
642       } while (YAP_IsPairTerm(t));
643       if (t == YAP_TermNil()) {
644         while (STACK_NOT_EMPTY(stack_args, stack_list))
645           node = put_entry(node, POP_UP(stack_args));
646         node = trie_node_check_insert(node, PairEndEmptyTag);
647       } else {
648         PUSH_DOWN(stack_args, t, stack_vars);
649         while (STACK_NOT_EMPTY(stack_args, stack_list))
650           node = put_entry(node, POP_UP(stack_args));
651         node = trie_node_check_insert(node, PairEndTermTag);
652       }
653     }
654   } else if (YAP_IsApplTerm(t)) {
655     YAP_Functor f = YAP_FunctorOfTerm(t);
656     if (f == FunctorComma) {
657       node = trie_node_check_insert(node, CommaInitTag);
658       do {
659         node = put_entry(node, YAP_ArgOfTerm(1, t));
660         t = YAP_Deref(YAP_ArgOfTerm(2, t));
661       } while (YAP_IsApplTerm(t) && YAP_FunctorOfTerm(t) == FunctorComma);
662       node = put_entry(node, t);
663       node = trie_node_check_insert(node, CommaEndTag);
664     } else {
665       int i;
666       node = trie_node_check_insert(node, ApplTag | ((YAP_Term) f));
667       for (i = 1; i <= YAP_ArityOfFunctor(f); i++)
668         node = put_entry(node, YAP_ArgOfTerm(i, t));
669     }
670   } else {
671     fprintf(stderr, "***************************************\n");
672     fprintf(stderr, "  Tries core module: unknown type tag\n");
673     fprintf(stderr, "***************************************\n");
674   }
675 
676   return node;
677 }
678 
679 
680 static
check_entry(TrNode node,YAP_Term entry)681 TrNode check_entry(TrNode node, YAP_Term entry) {
682   YAP_Term t = YAP_Deref(entry);
683   if (YAP_IsVarTerm(t)) {
684     if (IsTrieVar(t, stack_vars, stack_vars_base)) {
685       if (!(node = trie_node_check(node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2))))
686         return NULL;
687     } else {
688       if (!(node = trie_node_check(node, MkTrieVar((stack_vars_base - stack_vars) / 2))))
689         return NULL;
690       PUSH_UP(stack_vars, t, stack_args);
691       *((YAP_Term *)t) = (YAP_Term)stack_vars;
692       PUSH_UP(stack_vars, stack_vars, stack_args);
693     }
694   } else if (YAP_IsAtomTerm(t)) {
695     if (!(node = trie_node_check(node, t)))
696       return NULL;
697   } else if (YAP_IsIntTerm(t)) {
698     if (!(node = trie_node_check(node, t)))
699       return NULL;
700   } else if (YAP_IsFloatTerm(t)) {
701     volatile double f;
702     volatile YAP_Term *p;
703     f = YAP_FloatOfTerm(t);
704     p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */
705     if (!(node = trie_node_check(node, FloatInitTag)))
706       return NULL;
707     if (!(node = trie_node_check(node, *p)))
708       return NULL;
709 #ifdef TAG_LOW_BITS_32
710     if (!(node = trie_node_check(node, *(p + 1))))
711       return NULL;
712 #endif /* TAG_LOW_BITS_32 */
713     if (!(node = trie_node_check(node, FloatEndTag)))
714       return NULL;
715   } else if (YAP_IsPairTerm(t)) {
716     if (!(node = trie_node_check(node, PairInitTag)))
717       return NULL;
718     if ((CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) == TRIE_MODE_STANDARD) {
719       do {
720         if (!(node = check_entry(node, YAP_HeadOfTerm(t))))
721           return NULL;
722         t = YAP_Deref(YAP_TailOfTerm(t));
723       } while (YAP_IsPairTerm(t));
724       if (t == YAP_TermNil()) {
725         if (!(node = trie_node_check(node, PairEndEmptyTag)))
726           return NULL;
727       } else {
728         if (!(node = check_entry(node, t)))
729           return NULL;
730         if (!(node = trie_node_check(node, PairEndTermTag)))
731           return NULL;
732       }
733     } else if (CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */
734       YAP_Term *stack_list = stack_args;
735       do {
736         PUSH_DOWN(stack_args, YAP_HeadOfTerm(t), stack_vars);
737         t = YAP_Deref(YAP_TailOfTerm(t));
738       } while (YAP_IsPairTerm(t));
739       if (t == YAP_TermNil()) {
740         while (STACK_NOT_EMPTY(stack_args, stack_list))
741           if (!(node = check_entry(node, POP_UP(stack_args))))
742             return NULL;
743         if (!(node = trie_node_check(node, PairEndEmptyTag)))
744           return NULL;
745       } else {
746         PUSH_DOWN(stack_args, t, stack_vars);
747         while (STACK_NOT_EMPTY(stack_args, stack_list))
748           if (!(node = check_entry(node, POP_UP(stack_args))))
749             return NULL;
750         if (!(node = trie_node_check(node, PairEndTermTag)))
751           return NULL;
752       }
753     }
754   } else if (YAP_IsApplTerm(t)) {
755     YAP_Functor f = YAP_FunctorOfTerm(t);
756     if (f == FunctorComma) {
757       if (!(node = trie_node_check(node, CommaInitTag)))
758         return NULL;
759       do {
760         if (!(node = check_entry(node, YAP_ArgOfTerm(1, t))))
761           return NULL;
762         t = YAP_Deref(YAP_ArgOfTerm(2, t));
763       } while (YAP_IsApplTerm(t) && YAP_FunctorOfTerm(t) == FunctorComma);
764       if (!(node = check_entry(node, t)))
765         return NULL;
766       if (!(node = trie_node_check(node, CommaEndTag)))
767         return NULL;
768     } else {
769       int i;
770       if (!(node = trie_node_check(node, ApplTag | ((YAP_Term) f))))
771         return NULL;
772       for (i = 1; i <= YAP_ArityOfFunctor(f); i++)
773         if (!(node = check_entry(node, YAP_ArgOfTerm(i, t))))
774           return NULL;
775     }
776   } else {
777     fprintf(stderr, "***************************************\n");
778     fprintf(stderr, "  Tries core module: unknown type tag\n");
779     fprintf(stderr, "***************************************\n");
780   }
781 
782   return node;
783 }
784 
785 
786 static
get_entry(TrNode node,YAP_Term * stack_mark,TrNode * cur_node)787 YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
788   YAP_Term t = (YAP_Term) &t;
789   while (TrNode_parent(node)) {
790     t = TrNode_entry(node);
791     if (YAP_IsVarTerm(t)) {
792       int index = TrieVarIndex(t);
793       if (index > CURRENT_INDEX) {
794         int i;
795         stack_vars = &stack_vars_base[index + 1];
796         if (stack_vars > stack_args + 1) {
797           fprintf(stderr, "**************************************\n");
798           fprintf(stderr, "  Tries core module: term stack full\n");
799           fprintf(stderr, "**************************************\n");
800         }
801         for (i = index; i > CURRENT_INDEX; i--)
802           stack_vars_base[i] = 0;
803         CURRENT_INDEX = index;
804       }
805       if (stack_vars_base[index]) {
806         t = stack_vars_base[index];
807       } else {
808         t = YAP_MkVarTerm();
809         stack_vars_base[index] = t;
810       }
811       PUSH_UP(stack_args, t, stack_vars);
812     } else if (YAP_IsAtomTerm(t)) {
813       PUSH_UP(stack_args, t, stack_vars);
814     } else if (YAP_IsIntTerm(t)) {
815       PUSH_UP(stack_args, t, stack_vars);
816     } else if (YAP_IsPairTerm(t)) {
817       if (t == PairInitTag) {
818         YAP_Term t2;
819         if ((CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) == TRIE_MODE_STANDARD) {
820           YAP_Term *stack_aux = stack_mark;
821           t = *stack_aux--;
822           while (STACK_NOT_EMPTY(stack_aux, stack_args)) {
823             t2 = *stack_aux--;
824             t = YAP_MkPairTerm(t2, t);
825           }
826         } else if (CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */
827           YAP_Term *stack_aux = stack_mark;
828           t = *stack_aux;
829           if (t == YAP_TermNil())
830             stack_aux--;
831           else
832             t = POP_DOWN(stack_args);
833           while (STACK_NOT_EMPTY(stack_args, stack_aux)) {
834             t2 = POP_DOWN(stack_args);
835             t = YAP_MkPairTerm(t2, t);
836           }
837         }
838         stack_args = stack_mark;
839         *cur_node = node;
840         return t;
841       } else if (t == PairEndEmptyTag) {
842         t = YAP_TermNil();
843         PUSH_UP(stack_args, t, stack_vars);
844         node = TrNode_parent(node);
845         t = get_entry(node, &stack_args[1], &node);
846         PUSH_UP(stack_args, t, stack_vars);
847       } else if (t == PairEndTermTag) {
848         node = TrNode_parent(node);
849         t = get_entry(node, stack_args, &node);
850         PUSH_UP(stack_args, t, stack_vars);
851       } else if (t == CommaEndTag) {
852         node = TrNode_parent(node);
853         t = get_entry(node, stack_args, &node);
854         PUSH_UP(stack_args, t, stack_vars);
855       } else if (t == CommaInitTag) {
856         YAP_Term *stack_aux = stack_mark;
857         stack_aux--;
858         while (STACK_NOT_EMPTY(stack_aux, stack_args)) {
859           t = YAP_MkApplTerm(FunctorComma, 2, stack_aux);
860           *stack_aux = t;
861           stack_aux--;
862         }
863         stack_args = stack_mark;
864         *cur_node = node;
865         return t;
866       } else if (t == FloatEndTag) {
867         volatile double f;
868         volatile YAP_Term *p;
869         p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */
870 #ifdef TAG_LOW_BITS_32
871         node = TrNode_parent(node);
872         *(p + 1) = TrNode_entry(node);
873 #endif /* TAG_LOW_BITS_32 */
874         node = TrNode_parent(node);
875         *p = TrNode_entry(node);
876         node = TrNode_parent(node); /* ignore FloatInitTag */
877         t = YAP_MkFloatTerm(f);
878         PUSH_UP(stack_args, t, stack_vars);
879       } else if (t == FloatInitTag) {
880       }
881     } else if (ApplTag & t) {
882       YAP_Functor f = (YAP_Functor)(~ApplTag & t);
883       int arity = YAP_ArityOfFunctor(f);
884       t = YAP_MkApplTerm(f, arity, &stack_args[1]);
885       stack_args += arity;
886       PUSH_UP(stack_args, t, stack_vars);
887     } else {
888       fprintf(stderr, "***************************************\n");
889       fprintf(stderr, "  Tries core module: unknown type tag\n");
890       fprintf(stderr, "***************************************\n");
891     }
892     node = TrNode_parent(node);
893   }
894   *cur_node = node;
895   return t;
896 }
897 
898 
899 static
remove_entry(TrNode node)900 void remove_entry(TrNode node) {
901   TrNode parent = TrNode_parent(node);
902   while (parent) {
903     if (TrNode_previous(node)) {
904       if (IS_HASH_NODE(TrNode_child(parent))) {
905 	TrHash hash = (TrHash) TrNode_child(parent);
906 	TrHash_num_nodes(hash)--;
907 	if (TrHash_num_nodes(hash)) {
908 	  if (TrNode_next(node)) {
909 	    TrNode_next(TrNode_previous(node)) = TrNode_next(node);
910 	    TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
911 	  } else {
912 	    TrNode_next(TrNode_previous(node)) = NULL;
913 	  }
914 	  free_trie_node(node);
915 	  return;
916 	}
917 	free_hash_buckets(TrHash_buckets(hash), TrHash_num_buckets(hash));
918 	free_trie_hash(hash);
919       } else {
920 	if (TrNode_next(node)) {
921 	  TrNode_next(TrNode_previous(node)) = TrNode_next(node);
922 	  TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
923 	} else {
924 	  TrNode_next(TrNode_previous(node)) = NULL;
925 	}
926 	free_trie_node(node);
927 	return;
928       }
929     } else if (TrNode_next(node)) {
930       TrNode_child(parent) = TrNode_next(node);
931       TrNode_previous(TrNode_next(node)) = NULL;
932       free_trie_node(node);
933       return;
934     }
935     free_trie_node(node);
936     node = parent;
937     parent = TrNode_parent(node);
938   }
939   TrNode_child(node) = NULL;
940   return;
941 }
942 
943 
944 static
remove_child_nodes(TrNode node)945 void remove_child_nodes(TrNode node) {
946   if (IS_HASH_NODE(node)) {
947     TrNode *first_bucket, *bucket;
948     TrHash hash = (TrHash) node;
949     first_bucket = TrHash_buckets(hash);
950     bucket = first_bucket + TrHash_num_buckets(hash);
951     do {
952       if (*--bucket)
953 	remove_child_nodes(*bucket);
954     } while (bucket != first_bucket);
955     free_hash_buckets(first_bucket, TrHash_num_buckets(hash));
956     free_trie_hash(hash);
957     return;
958   }
959   if (TrNode_next(node))
960     remove_child_nodes(TrNode_next(node));
961   if (!IS_LEAF_TRIE_NODE(node))
962     remove_child_nodes(TrNode_child(node));
963   else {
964     if (DATA_DESTRUCT_FUNCTION)
965       (*DATA_DESTRUCT_FUNCTION)(node);
966     DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
967   }
968   free_trie_node(node);
969   return;
970 }
971 
972 
973 static
copy_child_nodes(TrNode parent_dest,TrNode child_source)974 TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
975   TrNode child_dest, next_dest;
976 
977   if (IS_HASH_NODE(child_source)) {
978     TrNode *bucket_dest, *first_bucket_source, *bucket_source;
979     TrHash hash_dest, hash_source;
980     hash_source = (TrHash) child_source;
981     first_bucket_source = TrHash_buckets(hash_source);
982     bucket_source = first_bucket_source + TrHash_num_buckets(hash_source);
983     new_trie_hash(hash_dest, TrHash_num_nodes(hash_source), TrHash_num_buckets(hash_source));
984     bucket_dest = TrHash_buckets(hash_dest) + TrHash_num_buckets(hash_dest);
985     do {
986       bucket_dest--;
987       if (*--bucket_source) {
988 	*bucket_dest = copy_child_nodes(parent_dest, *bucket_source);
989 	TrNode_previous(*bucket_dest) = AS_TR_NODE_NEXT(bucket_dest);
990       } else
991 	*bucket_dest = NULL;
992     } while (bucket_source != first_bucket_source);
993     return (TrNode) hash_dest;
994   }
995 
996   if (TrNode_next(child_source))
997     next_dest = copy_child_nodes(parent_dest, TrNode_next(child_source));
998   else
999     next_dest = NULL;
1000   new_trie_node(child_dest, TrNode_entry(child_source), parent_dest, NULL, next_dest, NULL);
1001   if (next_dest)
1002     TrNode_previous(next_dest) = child_dest;
1003   if (IS_LEAF_TRIE_NODE(child_source)) {
1004     MARK_AS_LEAF_TRIE_NODE(child_dest);
1005     INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
1006     if (DATA_COPY_FUNCTION)
1007       (*DATA_COPY_FUNCTION)(child_dest, child_source);
1008   } else
1009     TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source));
1010   return child_dest;
1011 }
1012 
1013 
1014 static
traverse_and_add(TrNode parent_dest,TrNode parent_source)1015 void traverse_and_add(TrNode parent_dest, TrNode parent_source) {
1016   TrNode child_dest, child_source;
1017 
1018   /* parent_source is not a leaf node */
1019   child_source = TrNode_child(parent_source);
1020   if (IS_HASH_NODE(child_source)) {
1021     TrNode *first_bucket_source, *bucket_source;
1022     TrHash hash_source;
1023     hash_source = (TrHash) child_source;
1024     first_bucket_source = TrHash_buckets(hash_source);
1025     bucket_source = first_bucket_source + TrHash_num_buckets(hash_source);
1026     do {
1027       child_source = *--bucket_source;
1028       while (child_source) {
1029 	/* parent_dest is not a leaf node */
1030 	child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
1031 	if (child_dest) {
1032 	  if (IS_LEAF_TRIE_NODE(child_dest)) {
1033 	    /* child_source is a leaf node */
1034 	    if (DATA_ADD_FUNCTION)
1035 	      (*DATA_ADD_FUNCTION)(child_dest, child_source);
1036 	  } else
1037 	    /* child_dest and child_source are not leaf nodes */
1038 	    traverse_and_add(child_dest, child_source);
1039 	}
1040 	child_source = TrNode_next(child_source);
1041       }
1042     } while (bucket_source != first_bucket_source);
1043     return;
1044   }
1045   while (child_source) {
1046     /* parent_dest is not a leaf node */
1047     child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
1048     if (child_dest) {
1049       if (IS_LEAF_TRIE_NODE(child_dest)) {
1050 	/* child_source is a leaf node */
1051 	if (DATA_ADD_FUNCTION)
1052 	  (*DATA_ADD_FUNCTION)(child_dest, child_source);
1053       } else
1054 	/* child_dest and child_source are not leaf nodes */
1055 	traverse_and_add(child_dest, child_source);
1056     }
1057     child_source = TrNode_next(child_source);
1058   }
1059   return;
1060 }
1061 
1062 
1063 static
traverse_and_join(TrNode parent_dest,TrNode parent_source)1064 void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
1065   TrNode child_dest, child_source;
1066 
1067   /* parent_source is not a leaf node */
1068   child_source = TrNode_child(parent_source);
1069   if (IS_HASH_NODE(child_source)) {
1070     TrNode *first_bucket_source, *bucket_source;
1071     TrHash hash_source;
1072     hash_source = (TrHash) child_source;
1073     first_bucket_source = TrHash_buckets(hash_source);
1074     bucket_source = first_bucket_source + TrHash_num_buckets(hash_source);
1075     do {
1076       child_source = *--bucket_source;
1077       while (child_source) {
1078 	/* parent_dest is not a leaf node */
1079 	child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
1080 	if (child_dest) {
1081 	  if (IS_LEAF_TRIE_NODE(child_dest)) {
1082 	    /* child_source is a leaf node */
1083 	    if (DATA_ADD_FUNCTION)
1084 	      (*DATA_ADD_FUNCTION)(child_dest, child_source);
1085 	  } else
1086 	    /* child_dest and child_source are not leaf nodes */
1087 	    traverse_and_join(child_dest, child_source);
1088 	} else {
1089 	  child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source));
1090 	  if (IS_LEAF_TRIE_NODE(child_source)) {
1091 	    MARK_AS_LEAF_TRIE_NODE(child_dest);
1092 	    INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
1093 	    if (DATA_COPY_FUNCTION)
1094 	      (*DATA_COPY_FUNCTION)(child_dest, child_source);
1095 	  } else
1096             TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source));
1097 	}
1098 	child_source = TrNode_next(child_source);
1099       }
1100     } while (bucket_source != first_bucket_source);
1101     return;
1102   }
1103   while (child_source) {
1104     /* parent_dest is not a leaf node */
1105     child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
1106     if (child_dest) {
1107       if (IS_LEAF_TRIE_NODE(child_dest)) {
1108 	/* child_source is a leaf node */
1109 	if (DATA_ADD_FUNCTION)
1110 	  (*DATA_ADD_FUNCTION)(child_dest, child_source);
1111       } else
1112 	/* child_dest and child_source are not leaf nodes */
1113 	traverse_and_join(child_dest, child_source);
1114     } else {
1115       child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source));
1116       if (IS_LEAF_TRIE_NODE(child_source)) {
1117 	MARK_AS_LEAF_TRIE_NODE(child_dest);
1118 	INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
1119 	if (DATA_COPY_FUNCTION)
1120 	  (*DATA_COPY_FUNCTION)(child_dest, child_source);
1121       } else
1122         TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source));
1123     }
1124     child_source = TrNode_next(child_source);
1125   }
1126   return;
1127 }
1128 
1129 
1130 static
traverse_and_intersect(TrNode parent_dest,TrNode parent_source)1131 void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) {
1132   TrNode child_dest, child_source, child_next;
1133 
1134   /* parent_dest is not a leaf node */
1135   child_dest = TrNode_child(parent_dest);
1136   if (IS_HASH_NODE(child_dest)) {
1137     TrNode *first_bucket_dest, *bucket_dest;
1138     TrHash hash_dest;
1139     hash_dest = (TrHash) child_dest;
1140     first_bucket_dest = TrHash_buckets(hash_dest);
1141     bucket_dest = first_bucket_dest + TrHash_num_buckets(hash_dest);
1142     do {
1143       child_dest = *--bucket_dest;
1144       while (child_dest) {
1145 	child_next = TrNode_next(child_dest);
1146 	/* parent_source is not a leaf node */
1147 	child_source = trie_node_check(parent_source, TrNode_entry(child_dest));
1148 	if (child_source) {
1149 	  if (IS_LEAF_TRIE_NODE(child_dest)) {
1150 	    /* child_source is a leaf node */
1151 	    if (DATA_ADD_FUNCTION)
1152 	      (*DATA_ADD_FUNCTION)(child_dest, child_source);
1153 	  } else
1154 	    /* child_dest and child_source are not leaf nodes */
1155 	    traverse_and_intersect(child_dest, child_source);
1156 	} else {
1157 	  if (IS_LEAF_TRIE_NODE(child_dest)) {
1158 	    if (DATA_DESTRUCT_FUNCTION)
1159 	      (*DATA_DESTRUCT_FUNCTION)(child_dest);
1160 	    DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
1161 	  } else
1162 	    remove_child_nodes(TrNode_child(child_dest));
1163 	  remove_entry(child_dest);
1164 	}
1165 	child_dest = child_next;
1166       }
1167     } while (bucket_dest != first_bucket_dest);
1168     return;
1169   }
1170   while (child_dest) {
1171     child_next = TrNode_next(child_dest);
1172     /* parent_source is not a leaf node */
1173     child_source = trie_node_check(parent_source, TrNode_entry(child_dest));
1174     if (child_source) {
1175       if (IS_LEAF_TRIE_NODE(child_dest)) {
1176 	/* child_source is a leaf node */
1177 	if (DATA_ADD_FUNCTION)
1178 	  (*DATA_ADD_FUNCTION)(child_dest, child_source);
1179       } else
1180 	/* child_dest and child_source are not leaf nodes */
1181 	traverse_and_intersect(child_dest, child_source);
1182     } else {
1183       if (IS_LEAF_TRIE_NODE(child_dest)) {
1184 	if (DATA_DESTRUCT_FUNCTION)
1185 	  (*DATA_DESTRUCT_FUNCTION)(child_dest);
1186 	DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
1187       } else
1188 	remove_child_nodes(TrNode_child(child_dest));
1189       remove_entry(child_dest);
1190     }
1191     child_dest = child_next;
1192   }
1193   return;
1194 }
1195 
1196 
1197 static
traverse_and_count_common_entries(TrNode parent1,TrNode parent2)1198 YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) {
1199   TrNode child1, child2;
1200   YAP_Int count = 0;
1201 
1202   /* parent1 is not a leaf node */
1203   child1 = TrNode_child(parent1);
1204   if (IS_HASH_NODE(child1)) {
1205     TrNode *first_bucket, *bucket;
1206     TrHash hash;
1207     hash = (TrHash) child1;
1208     first_bucket = TrHash_buckets(hash);
1209     bucket = first_bucket + TrHash_num_buckets(hash);
1210     do {
1211       child1 = *--bucket;
1212       while (child1) {
1213 	/* parent2 is not a leaf node */
1214 	child2 = trie_node_check(parent2, TrNode_entry(child1));
1215 	if (child2) {
1216 	  if (IS_LEAF_TRIE_NODE(child1))
1217 	    /* child2 is a leaf node */
1218 	    count++;
1219 	  else
1220 	    /* child1 and child2 are not leaf nodes */
1221 	    count += traverse_and_count_common_entries(child1, child2);
1222 	}
1223 	child1 = TrNode_next(child1);
1224       }
1225     } while (bucket != first_bucket);
1226     return count;
1227   }
1228   while (child1) {
1229     /* parent2 is not a leaf node */
1230     child2 = trie_node_check(parent2, TrNode_entry(child1));
1231     if (child2) {
1232       if (IS_LEAF_TRIE_NODE(child1))
1233 	/* child2 is a leaf node */
1234 	count++;
1235       else
1236 	/* child1 and child2 are not leaf nodes */
1237 	count += traverse_and_count_common_entries(child1, child2);
1238     }
1239     child1 = TrNode_next(child1);
1240   }
1241   return count;
1242 }
1243 
1244 
1245 static
traverse_and_count_entries(TrNode node)1246 YAP_Int traverse_and_count_entries(TrNode node) {
1247   YAP_Int count = 0;
1248 
1249   if (IS_HASH_NODE(node)) {
1250     TrNode *first_bucket, *bucket;
1251     TrHash hash;
1252     hash = (TrHash) node;
1253     first_bucket = TrHash_buckets(hash);
1254     bucket = first_bucket + TrHash_num_buckets(hash);
1255     do {
1256       if (*--bucket) {
1257         node = *bucket;
1258         count += traverse_and_count_entries(node);
1259       }
1260     } while (bucket != first_bucket);
1261     return count;
1262   }
1263 
1264   if (TrNode_next(node))
1265     count += traverse_and_count_entries(TrNode_next(node));
1266   if (!IS_LEAF_TRIE_NODE(node))
1267     count += traverse_and_count_entries(TrNode_child(node));
1268   else
1269     count++;
1270   return count;
1271 }
1272 
1273 
1274 static
traverse_and_get_usage(TrNode node,YAP_Int depth)1275 void traverse_and_get_usage(TrNode node, YAP_Int depth) {
1276   if (IS_HASH_NODE(node)) {
1277     TrNode *first_bucket, *bucket;
1278     TrHash hash;
1279     hash = (TrHash) node;
1280     first_bucket = TrHash_buckets(hash);
1281     bucket = first_bucket + TrHash_num_buckets(hash);
1282     do {
1283       if (*--bucket) {
1284         node = *bucket;
1285         traverse_and_get_usage(node, depth);
1286       }
1287     } while (bucket != first_bucket);
1288     return;
1289   }
1290 
1291   USAGE_NODES++;
1292   if (TrNode_next(node))
1293     traverse_and_get_usage(TrNode_next(node), depth);
1294   depth++;
1295   if (!IS_LEAF_TRIE_NODE(node)) {
1296     traverse_and_get_usage(TrNode_child(node), depth);
1297   } else {
1298     USAGE_ENTRIES++;
1299     USAGE_VIRTUAL_NODES+= depth;
1300   }
1301   return;
1302 }
1303 
1304 
1305 static
traverse_and_save(TrNode node,FILE * file,int float_block)1306 void traverse_and_save(TrNode node, FILE *file, int float_block) {
1307   YAP_Term t;
1308 
1309   if (IS_HASH_NODE(node)) {
1310     TrNode *first_bucket, *bucket;
1311     TrHash hash;
1312     hash = (TrHash) node;
1313     fprintf(file, "%lu %d ", HASH_SAVE_MARK, TrHash_num_buckets(hash));
1314     first_bucket = TrHash_buckets(hash);
1315     bucket = first_bucket + TrHash_num_buckets(hash);
1316     do {
1317       if (*--bucket) {
1318         node = *bucket;
1319 	traverse_and_save(node, file, float_block);
1320       }
1321     } while (bucket != first_bucket);
1322     return;
1323   }
1324 
1325   if (TrNode_next(node))
1326     traverse_and_save(TrNode_next(node), file, float_block);
1327 
1328   t = TrNode_entry(node);
1329   if (float_block) {
1330     float_block--;
1331     fprintf(file, "%lu %lu ", FLOAT_SAVE_MARK, t);
1332   } else if (YAP_IsPairTerm(t)) {
1333     if (t == FloatInitTag) {
1334 #ifdef TAG_LOW_BITS_32
1335       float_block++;
1336 #endif /* TAG_LOW_BITS_32 */
1337       float_block ++;
1338     }
1339     fprintf(file, "%lu ", t);
1340   } else if (YAP_IsVarTerm(t) || YAP_IsIntTerm(t))
1341     fprintf(file, "%lu ", t);
1342   else {
1343     int index;
1344     for (index = 0; index <= CURRENT_INDEX; index++)
1345       if (AUXILIARY_TERM_STACK[index] == t)
1346 	break;
1347     if (index > CURRENT_INDEX) {
1348       CURRENT_INDEX = index;
1349       if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
1350 	expand_auxiliary_term_stack();
1351       AUXILIARY_TERM_STACK[CURRENT_INDEX] = t;
1352       if (YAP_IsAtomTerm(t))
1353 	  fprintf(file, "%lu %d %s%c ", ATOM_SAVE_MARK, index, YAP_AtomName(YAP_AtomOfTerm(t)), '\0');
1354       else  /* (ApplTag & t) */
1355 	fprintf(file, "%lu %d %s %d ", FUNCTOR_SAVE_MARK, index,
1356 		YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))),
1357 		YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t)));
1358     } else
1359       if (YAP_IsAtomTerm(t))
1360 	fprintf(file, "%lu %d ", ATOM_SAVE_MARK, index);
1361       else
1362 	fprintf(file, "%lu %d ", FUNCTOR_SAVE_MARK, index);
1363   }
1364   if (IS_LEAF_TRIE_NODE(node)) {
1365     fprintf(file, "- ");
1366     if (DATA_SAVE_FUNCTION)
1367       (*DATA_SAVE_FUNCTION)(node, file);
1368   }
1369   else {
1370     traverse_and_save(TrNode_child(node), file, float_block);
1371     fprintf(file, "- ");
1372   }
1373   return;
1374 }
1375 
1376 
1377 static
traverse_and_load(TrNode parent,FILE * file)1378 void traverse_and_load(TrNode parent, FILE *file) {
1379   TrHash hash = NULL;
1380   YAP_Term t;
1381   int n;
1382 
1383   if (!fscanf(file, "%lu", &t)) {
1384     MARK_AS_LEAF_TRIE_NODE(parent);
1385     INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
1386     if (DATA_LOAD_FUNCTION)
1387       (*DATA_LOAD_FUNCTION)(parent, CURRENT_DEPTH, file);
1388     CURRENT_DEPTH--;
1389     return;
1390   }
1391   if (t == HASH_SAVE_MARK) {
1392     /* alloc a new trie hash */
1393     int num_buckets;
1394     n = fscanf(file, "%d", &num_buckets);
1395     new_trie_hash(hash, 0, num_buckets);
1396     TrNode_child(parent) = (TrNode) hash;
1397     n = fscanf(file, "%lu", &t);
1398   }
1399   do {
1400     TrNode child;
1401     if (t == ATOM_SAVE_MARK) {
1402       int index;
1403       n = fscanf(file, "%d", &index);
1404       if (index > CURRENT_INDEX) {
1405 	char atom[1000];
1406 	if (CURRENT_LOAD_VERSION == 2) {
1407 	  char *ptr, ch;
1408 	  ptr = atom;
1409 	  fgetc(file);  /* skip the first empty space */
1410 	  while ((ch = fgetc(file)))
1411 	    *ptr++ = ch;
1412 	  *ptr = '\0';
1413 	} else if (CURRENT_LOAD_VERSION == 1) {
1414 	  n = fscanf(file, "%s", atom);
1415 	}
1416 	CURRENT_INDEX = index;
1417 	if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
1418 	  expand_auxiliary_term_stack();
1419 	AUXILIARY_TERM_STACK[CURRENT_INDEX] = YAP_MkAtomTerm(YAP_LookupAtom(atom));
1420       }
1421       t = AUXILIARY_TERM_STACK[index];
1422     } else if (t == FUNCTOR_SAVE_MARK) {
1423       int index;
1424       n = fscanf(file, "%d", &index);
1425       if (index > CURRENT_INDEX) {
1426 	char atom[1000];
1427 	int arity;
1428 	n = fscanf(file, "%s %d", atom, &arity);
1429 	CURRENT_INDEX = index;
1430 	if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
1431 	  expand_auxiliary_term_stack();
1432 	AUXILIARY_TERM_STACK[CURRENT_INDEX] = ApplTag | ((YAP_Term) YAP_MkFunctor(YAP_LookupAtom(atom), arity));
1433       }
1434       t = AUXILIARY_TERM_STACK[index];
1435     } else if (t == FLOAT_SAVE_MARK)
1436       n = fscanf(file, "%lu", &t);
1437     child = trie_node_insert(parent, t, hash);
1438     traverse_and_load(child, file);
1439   } while (fscanf(file, "%lu", &t));
1440   CURRENT_DEPTH--;
1441   return;
1442 }
1443 
1444 
1445 static
traverse_and_print(TrNode node,int * arity,char * str,int str_index,int mode)1446 void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int mode) {
1447   YAP_Term t;
1448   int last_pair_mark = -arity[arity[0]];
1449 
1450   if (IS_HASH_NODE(node)) {
1451     int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
1452     TrNode *first_bucket, *bucket;
1453     TrHash hash;
1454     hash = (TrHash) node;
1455     first_bucket = TrHash_buckets(hash);
1456     bucket = first_bucket + TrHash_num_buckets(hash);
1457     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
1458     do {
1459       if (*--bucket) {
1460         node = *bucket;
1461         traverse_and_print(node, arity, str, str_index, mode);
1462 	memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
1463 	if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
1464 	  /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */
1465 	  if (str[str_index - 1] != '[')
1466 	    str[str_index - 1] = ',';
1467 	  /* restore possible PairEndTermTag side-effect */
1468 	  if (str[last_pair_mark] == '|')
1469 	    str[last_pair_mark] = ',';
1470 	}
1471       }
1472     } while (bucket != first_bucket);
1473     free(current_arity);
1474     return;
1475   }
1476 
1477   if (TrNode_next(node)) {
1478     int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
1479     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
1480     traverse_and_print(TrNode_next(node), arity, str, str_index, mode);
1481     memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
1482     if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
1483       /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */
1484       if (str[str_index - 1] != '[')
1485 	str[str_index - 1] = ',';
1486       /* restore possible PairEndTermTag side-effect */
1487       if (str[last_pair_mark] == '|')
1488 	str[last_pair_mark] = ',';
1489     }
1490     free(current_arity);
1491   }
1492 
1493   /* update position for possible PairEndTermTag side-effect */
1494   if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0 && str_index > 1)
1495     arity[arity[0]] = -str_index + 1;
1496 
1497   t = TrNode_entry(node);
1498   if (mode == TRIE_PRINT_FLOAT) {
1499 #ifdef TAG_LOW_BITS_32
1500     arity[arity[0]] = (YAP_Int) t;
1501     mode = TRIE_PRINT_FLOAT2;
1502   } else if (mode == TRIE_PRINT_FLOAT2) {
1503     volatile double f;
1504     volatile YAP_Term *p;
1505     p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */
1506     *(p + 1) = t;
1507     *p = (YAP_Term) arity[arity[0]];
1508     arity[arity[0]] = -1;
1509 #else /* TAG_64BITS */
1510     volatile double f;
1511     volatile YAP_Term *p;
1512     p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */
1513     *p = t;
1514 #endif /* TAG_SCHEME */
1515     str_index += sprintf(& str[str_index], "%.15g", f);
1516     mode = TRIE_PRINT_FLOAT_END;
1517   } else if (mode == TRIE_PRINT_FLOAT_END) {
1518     arity[0]--;
1519     while (arity[0]) {
1520       if (arity[arity[0]] == 1) {
1521 	str_index += sprintf(& str[str_index], ")");
1522 	arity[0]--;
1523       } else {
1524 	if (arity[arity[0]] > 1)
1525 	  arity[arity[0]]--;
1526 	str_index += sprintf(& str[str_index], ",");
1527 	break;
1528       }
1529     }
1530     mode = TRIE_PRINT_NORMAL;
1531   } else if (YAP_IsVarTerm(t)) {
1532     str_index += sprintf(& str[str_index], "VAR%ld", TrieVarIndex(t));
1533     while (arity[0]) {
1534       if (arity[arity[0]] == 1) {
1535 	str_index += sprintf(& str[str_index], ")");
1536 	arity[0]--;
1537       } else {
1538 	if (arity[arity[0]] > 1)
1539 	  arity[arity[0]]--;
1540 	str_index += sprintf(& str[str_index], ",");
1541 	break;
1542       }
1543     }
1544   } else if (YAP_IsAtomTerm(t)) {
1545     str_index += sprintf(& str[str_index], "%s", YAP_AtomName(YAP_AtomOfTerm(t)));
1546     while (arity[0]) {
1547       if (arity[arity[0]] == 1) {
1548 	str_index += sprintf(& str[str_index], ")");
1549 	arity[0]--;
1550       } else {
1551 	if (arity[arity[0]] > 1)
1552 	  arity[arity[0]]--;
1553 	str_index += sprintf(& str[str_index], ",");
1554 	break;
1555       }
1556     }
1557   } else if (YAP_IsIntTerm(t)) {
1558     str_index += sprintf(& str[str_index], "%ld", YAP_IntOfTerm(t));
1559     while (arity[0]) {
1560       if (arity[arity[0]] == 1) {
1561 	str_index += sprintf(& str[str_index], ")");
1562 	arity[0]--;
1563       } else {
1564 	if (arity[arity[0]] > 1)
1565 	  arity[arity[0]]--;
1566 	str_index += sprintf(& str[str_index], ",");
1567 	break;
1568       }
1569     }
1570   } else if (YAP_IsPairTerm(t)) {
1571     if (t == FloatInitTag) {
1572       mode = TRIE_PRINT_FLOAT;
1573       arity[0]++;
1574       arity[arity[0]] = -1;
1575     } else if (t == PairInitTag) {
1576       str_index += sprintf(& str[str_index], "[");
1577       arity[0]++;
1578       arity[arity[0]] = -1;
1579     } else if (t == CommaInitTag) {
1580       str_index += sprintf(& str[str_index], "(");
1581       arity[0]++;
1582       arity[arity[0]] = -1;
1583     } else {
1584       if (t == PairEndEmptyTag)
1585 	str[str_index - 1] = ']';
1586       else if (t == PairEndTermTag) {
1587 	str[last_pair_mark] = '|';
1588 	str[str_index - 1] = ']';
1589       } else /*   (t == CommaEndTag)   */
1590 	str[str_index - 1] = ')';
1591       arity[0]--;
1592       while (arity[0]) {
1593 	if (arity[arity[0]] == 1) {
1594 	  str_index += sprintf(& str[str_index], ")");
1595 	  arity[0]--;
1596 	} else {
1597 	  if (arity[arity[0]] > 1)
1598 	    arity[arity[0]]--;
1599 	  str_index += sprintf(& str[str_index], ",");
1600 	  break;
1601 	}
1602       }
1603     }
1604   } else if (ApplTag & t) {
1605     str_index += sprintf(& str[str_index], "%s(", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))));
1606     arity[0]++;
1607     arity[arity[0]] = YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t));
1608   } else {
1609     fprintf(stderr, "***************************************\n");
1610     fprintf(stderr, "  Tries core module: unknown type tag\n");
1611     fprintf(stderr, "***************************************\n");
1612   }
1613 
1614   if (arity[0]) {
1615     traverse_and_print(TrNode_child(node), arity, str, str_index, mode);
1616   } else {
1617     str[str_index] = 0;
1618     fprintf(stdout, "%s\n", str);
1619     if (DATA_PRINT_FUNCTION)
1620       (*DATA_PRINT_FUNCTION)(node);
1621   }
1622   return;
1623 }
1624 
1625 
1626 static
trie_to_list(TrNode node)1627 YAP_Term trie_to_list(TrNode node) {
1628   YAP_Term tail = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
1629 
1630 #define CONSUME_NODE_LIST                                  \
1631   do {                                                     \
1632     /* add node result to list */                          \
1633     tail = YAP_MkPairTerm(trie_to_list_node(node), tail);  \
1634   } while((node = TrNode_next(node)));
1635 
1636   if (IS_HASH_NODE(node)) {
1637     TrNode *first_bucket, *bucket;
1638     TrHash hash = (TrHash) node;
1639 
1640     first_bucket = TrHash_buckets(hash);
1641     bucket = first_bucket + TrHash_num_buckets(hash);
1642 
1643     /* iterate through valid hash positions and consume each list */
1644     do {
1645       if (*--bucket) {
1646         node = *bucket;
1647         CONSUME_NODE_LIST;
1648       }
1649     } while (bucket != first_bucket);
1650   } else {
1651     CONSUME_NODE_LIST;
1652   }
1653 #undef CONSUME_NODE_LIST
1654 
1655   /* return list of trie options at this level */
1656   return tail;
1657 }
1658 
1659 
1660 static
trie_to_list_node(TrNode node)1661 YAP_Term trie_to_list_node(TrNode node) {
1662   YAP_Term t = TrNode_entry(node);
1663 
1664   if(YAP_IsIntTerm(t) || YAP_IsAtomTerm(t)) {
1665     return trie_to_list_create_two(YAP_IsIntTerm(t) ? "int" : "atom", node, t);
1666   } else if (YAP_IsVarTerm(t)) {
1667     int index = TrieVarIndex(t);
1668     YAP_Term index_term = YAP_MkIntTerm((YAP_Int)index);
1669     return trie_to_list_create_two("var", node, index_term);
1670   } else if (YAP_IsPairTerm(t)) {
1671     if(t == FloatInitTag) {
1672       node = TrNode_child(node); /* consume FloatInitTag */
1673       YAP_Functor f = YAP_MkFunctor(YAP_LookupAtom("floats"), 1);
1674       YAP_Term child = trie_to_list_floats(node);
1675       return YAP_MkApplTerm(f, 1, &child);
1676     } else if(t == PairInitTag) {
1677       return trie_to_list_create_simple("list", node);
1678     } else if (t == PairEndEmptyTag) {
1679       return trie_to_list_create_simple_end("endlist", node);
1680     } else if (t == CommaInitTag) {
1681       return trie_to_list_create_simple("comma", node);
1682     } else if (t == CommaEndTag) {
1683       return trie_to_list_create_simple_end("endcomma", node);
1684     }
1685   } else if (ApplTag & t) {
1686     YAP_Functor f = (YAP_Functor)(~ApplTag & t);
1687     int arity = YAP_ArityOfFunctor(f);
1688     YAP_Functor new_f = YAP_MkFunctor(YAP_LookupAtom("functor"), 3);
1689     YAP_Term args[3] = {
1690       YAP_MkAtomTerm(YAP_NameOfFunctor(f)),
1691       YAP_MkIntTerm((YAP_Int)arity),
1692       trie_to_list(TrNode_child(node))
1693     };
1694     return YAP_MkApplTerm(new_f, 3, args);
1695   }
1696   fprintf(stderr, "***************************************\n");
1697   fprintf(stderr, "  Tries core module: unknown type tag\n");
1698   fprintf(stderr, "***************************************\n");
1699 
1700   return YAP_MkAtomTerm(YAP_LookupAtom("fail"));
1701 }
1702 
1703 
1704 #define PUSH_NEW_FLOAT_TERM(val)                                                     \
1705         result = YAP_MkPairTerm(                                                     \
1706         trie_to_list_create_two("float", TrNode_child(node), YAP_MkFloatTerm(val)),  \
1707         result);
1708 
1709 
1710 #ifdef TAG_LOW_BITS_32
1711 static inline
trie_to_list_floats_tag_low_32(YAP_Term result,TrNode node,volatile YAP_Term ** p,volatile double * f)1712 YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile YAP_Term **p, volatile double *f) {
1713   if(IS_HASH_NODE(node)) {
1714     TrNode *first_bucket, *bucket;
1715     TrHash hash = (TrHash) node;
1716 
1717     first_bucket = TrHash_buckets(hash);
1718     bucket = first_bucket + TrHash_num_buckets(hash);
1719 
1720     do {
1721       if(*--bucket) {
1722         node = *bucket;
1723 
1724         do {
1725           *(*p + 1) = TrNode_entry(node);
1726           PUSH_NEW_FLOAT_TERM(*f);
1727         } while((node = TrNode_next(node)));
1728       }
1729     } while (bucket != first_bucket);
1730   } else {
1731     do {
1732       *(*p + 1) = TrNode_entry(node);
1733       PUSH_NEW_FLOAT_TERM(*f);
1734     } while((node = TrNode_next(node)));
1735   }
1736 
1737   return result;
1738 }
1739 #endif /* TAG_LOW_BITS_32 */
1740 
1741 
1742 static
trie_to_list_floats(TrNode node)1743 YAP_Term trie_to_list_floats(TrNode node) {
1744   volatile double f;
1745   volatile YAP_Term *p;
1746   YAP_Term result = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
1747 
1748   p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */
1749   if (IS_HASH_NODE(node)) {
1750     TrNode *first_bucket, *bucket;
1751     TrHash hash = (TrHash) node;
1752     first_bucket = TrHash_buckets(hash);
1753     bucket = first_bucket + TrHash_num_buckets(hash);
1754     do {
1755       if (*--bucket) {
1756         node = *bucket;
1757         do {
1758           *p = TrNode_entry(node);
1759 #ifdef TAG_LOW_BITS_32
1760           result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &p, &f);
1761 #else
1762           PUSH_NEW_FLOAT_TERM(f);
1763 #endif /* TAG_LOW_BITS_32 */
1764         } while((node = TrNode_next(node)));
1765       }
1766     } while (bucket != first_bucket);
1767   } else {
1768     do {
1769       *p = TrNode_entry(node);
1770 #ifdef TAG_LOW_BITS_32
1771       result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &p, &f);
1772 #else
1773       PUSH_NEW_FLOAT_TERM(f);
1774 #endif /* TAG_LOW_BITS_32 */
1775     } while((node = TrNode_next(node)));
1776   }
1777 
1778   return result;
1779 }
1780 #undef PUSH_NEW_FLOAT_TERM
1781 
1782 
1783 #include "core_dbtries.c"
1784