diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of https://www.github.com/vscosta/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2014-11-09 17:30:15 +00:00
commit 24920a230f
4 changed files with 927 additions and 756 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1436
C/threads.c
View File

File diff suppressed because it is too large Load Diff

5
library/flags.yap
View File

@ -264,9 +264,8 @@ flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, MH
throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]), ; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]),
throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ callable(Handler) -> ; \+ callable(Handler) -> % the Handler comes from: strip_module(MHandler, Module, Handler)
strip_module(Handler, Mod, G), throw(error(type_error(callable, Handler), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
throw(error(type_error(callable, G), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; ;
validate(FlagType, Module:Handler, DefaultValue, FlagName), validate(FlagType, Module:Handler, DefaultValue, FlagName),
assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)), assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)),

1
library/tries/base_dbtries.c
View File

@ -237,6 +237,7 @@ YAP_Term trie_depth_breadth(TrEntry trie, TrEntry db_trie, YAP_Int opt_level, YA
core_initialize_depth_breadth_trie(TrEntry_trie(db_trie), &depth_node, &breadth_node); core_initialize_depth_breadth_trie(TrEntry_trie(db_trie), &depth_node, &breadth_node);
set_depth_breadth_reduction_current_data(NULL); set_depth_breadth_reduction_current_data(NULL);
/* We only need to simplify the trie once! */ /* We only need to simplify the trie once! */
/* This can be a 10% overhead for sld cases :-( */
if (TrNode_child(TrEntry_trie(trie))) if (TrNode_child(TrEntry_trie(trie)))
simplification_reduction(trie); simplification_reduction(trie);
while (TrNode_child(TrEntry_trie(trie))) { while (TrNode_child(TrEntry_trie(trie))) {

241
library/tries/core_dbtries.c
View File

@ -212,6 +212,7 @@ YAP_Term update_depth_breadth_trie(TrEngine engine, TrNode root, YAP_Int opt_lev
YAP_Term get_return_node_term(TrNode node); YAP_Term get_return_node_term(TrNode node);
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term); void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term);
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term); TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term);
void check_attach_childs(TrNode search_child, TrNode existing_child);
TrNode get_simplification_sibling(TrNode node); TrNode get_simplification_sibling(TrNode node);
TrNode check_parent_first(TrNode node); TrNode check_parent_first(TrNode node);
TrNode TrNode_myparent(TrNode node); TrNode TrNode_myparent(TrNode node);
@ -220,8 +221,12 @@ TrNode TrNode_myparent(TrNode node);
/* Debug Procedures */ /* Debug Procedures */
/* -------------------------- */ /* -------------------------- */
inline void displaynode(TrNode node); void displaynode(TrNode node);
inline void displayentry(TrNode node); void displayentry(TrNode node);
void displayterm(YAP_Term term);
void displaytrie(TrNode node);
void display_trie_inner(TrNode node);
void trie_display_node(TrNode node);
/* -------------------------- */ /* -------------------------- */
@ -256,42 +261,6 @@ void core_depth_breadth_trie_replace_nested_trie(TrNode node, YAP_Int nested_tri
traverse_and_replace_nested_trie(node, nested_trie_id, new_term); traverse_and_replace_nested_trie(node, nested_trie_id, new_term);
return; return;
} }
inline
void displaynode(TrNode node) {
if (node != NULL) {
/* printf("hi\n");
if (IS_HASH_NODE(node))
{printf("1\n");} else {printf("2\n");}
printf("bye\n");*/
if (IS_HASH_NODE(node))
printf("HASH n%i, b%i, p%p\n", TrHash_num_nodes((TrHash) node), TrHash_num_buckets((TrHash) node), node);
else if (TrNode_entry(node) == PairInitTag)
printf("PairInitTag\n");
else if (TrNode_entry(node) == PairEndTag)
printf("PairEndTag\n");
else if (IS_FUNCTOR_NODE(node))
printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
else if (YAP_IsIntTerm(TrNode_entry(node)))
printf("int(" Int_FORMAT ")\n", YAP_IntOfTerm(TrNode_entry(node)));
else if (YAP_IsAtomTerm(TrNode_entry(node)))
printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
else
printf("What?\n");
} else
printf("null\n");
return;
}
inline
void displayentry(TrNode node) {
printf("Entry Contains Bottom Up:\n");
while (node) {
displaynode(node);
node = TrNode_parent(node);
}
printf("--- End of Entry ---\n");
}
inline inline
@ -302,6 +271,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term); traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term);
return; return;
} else if (IS_HASH_NODE(node)) { } else if (IS_HASH_NODE(node)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort(); abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) node; TrHash hash = (TrHash) node;
@ -322,7 +292,8 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
if (arity == 1 && strcmp(YAP_AtomName(YAP_NameOfFunctor(f)), NESTED_TRIE_TERM) == 0) { if (arity == 1 && strcmp(YAP_AtomName(YAP_NameOfFunctor(f)), NESTED_TRIE_TERM) == 0) {
child = TrNode_child(node); child = TrNode_child(node);
if (IS_HASH_NODE(child)) { if (IS_HASH_NODE(child)) {
abort(); printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) child; TrHash hash = (TrHash) child;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -372,6 +343,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
/* fixmeeee */ /* fixmeeee */
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) { TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
TrNode newnode, temp, newnodef = NULL; TrNode newnode, temp, newnodef = NULL;
YAP_Term term_search = (YAP_Term) NULL;
if (YAP_IsApplTerm(new_term)) { if (YAP_IsApplTerm(new_term)) {
YAP_Term new_term_functor = ApplTag | ((YAP_Term) YAP_FunctorOfTerm(new_term)); YAP_Term new_term_functor = ApplTag | ((YAP_Term) YAP_FunctorOfTerm(new_term));
YAP_Int arity = YAP_ArityOfFunctor(YAP_FunctorOfTerm(new_term)); YAP_Int arity = YAP_ArityOfFunctor(YAP_FunctorOfTerm(new_term));
@ -397,12 +369,38 @@ TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
TrNode_previous(TrNode_child(newnodef)) = newnode; TrNode_previous(TrNode_child(newnodef)) = newnode;
TrNode_child(newnodef) = newnode; TrNode_child(newnodef) = newnode;
} else { } else {
new_trie_node(newnode, new_term, TrNode_parent(node), TrNode_child(child), TrNode_child(TrNode_parent(node)), NULL); // Rewind to first uncle node
TrNode_previous(TrNode_child(TrNode_parent(node))) = newnode; temp = TrNode_parent(node);
TrNode_child(TrNode_parent(node)) = newnode; if (IS_FUNCTOR_NODE(temp))
term_search = TrNode_entry(temp);
while (TrNode_previous(temp))
temp = TrNode_previous(temp);
// Handles cases like not(t(?)) but doesn't handle case like not(not(...)
if (term_search) {
while (temp && TrNode_entry(temp) != term_search)
temp = TrNode_next(temp);
if (temp)
temp = TrNode_child(temp);
}
while (temp && TrNode_entry(temp) != new_term)
temp = TrNode_next(temp);
if (temp) { // Found a node we can reuse
newnode = temp;
// Check if the childs of node/child exist already otherwise attach them
check_attach_childs(TrNode_child(child), TrNode_child(newnode));
//DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(child));
remove_entry(child);
return newnode;
} else { // Make a new node
new_trie_node(newnode, new_term, TrNode_parent(node), TrNode_child(child), TrNode_child(TrNode_parent(node)), NULL);
TrNode_previous(TrNode_child(TrNode_parent(node))) = newnode;
TrNode_child(TrNode_parent(node)) = newnode;
}
} }
temp = TrNode_child(child); temp = TrNode_child(child);
if (IS_HASH_NODE(temp)) { if (IS_HASH_NODE(temp)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort(); abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) temp; TrHash hash = (TrHash) temp;
@ -428,6 +426,23 @@ TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
} }
void check_attach_childs(TrNode search_child, TrNode existing_child) {
// Check if the childs of node/child exist already otherwise attach them
do {
while(existing_child && (TrNode_entry(existing_child) != TrNode_entry(search_child)))
existing_child = TrNode_next(existing_child);
if (existing_child) {
if (TrNode_entry(existing_child) != PairEndTag) {
check_attach_childs(TrNode_child(search_child), TrNode_child(existing_child));
}
} else {
printf("Need to attach child!\n");
abort();
}
search_child = TrNode_next(search_child);
} while(search_child);
}
YAP_Term core_get_trie_db_return_term(void) { YAP_Term core_get_trie_db_return_term(void) {
return TRIE_DEPTH_BREADTH_RETURN_TERM; return TRIE_DEPTH_BREADTH_RETURN_TERM;
@ -557,6 +572,8 @@ TrNode core_depth_reduction(TrEngine engine, TrNode node, TrNode depth_node, YAP
} }
TrNode temp = TrNode_child(TrNode_parent(node)); TrNode temp = TrNode_child(TrNode_parent(node));
if (IS_HASH_NODE(temp)) { if (IS_HASH_NODE(temp)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) temp; TrHash hash = (TrHash) temp;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -618,7 +635,9 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
child = TrNode_child(node); child = TrNode_child(node);
// printf("Chosen start node: "); displaynode(child); // printf("Chosen start node: "); displaynode(child);
if (IS_HASH_NODE(child)) { if (IS_HASH_NODE(child)) {
printf("warning\n"); printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
/* Comment code for HASH NODES - the commented code 100% has a bug
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) child; TrHash hash = (TrHash) child;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -658,7 +677,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} }
//Nested Trie code //Nested Trie code
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) { if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) {
/* nested trie: stop procedure and return nested trie node */ // nested trie: stop procedure and return nested trie node
return child; return child;
} }
PUSH_DOWN(stack_args, TrNode_entry(child), stack_top); PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
@ -676,11 +695,14 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} while (child); } while (child);
} }
} while (bucket != first_bucket); } while (bucket != first_bucket);
*/
} else { } else {
do { do {
if (TrNode_entry(child) == PairEndTag) { if (TrNode_entry(child) == PairEndTag) {
/* do breadth reduction simplification */ /* do breadth reduction simplification */
printf("I should never arrive here, please contact Theo!\n"); printf("SIMPLIFICATION ERROR: I should never arrive here, please contact Theo!\n");
abort();
/*
node = TrNode_parent(child); node = TrNode_parent(child);
DATA_DESTRUCT_FUNCTION = destruct_function; DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(node)); remove_child_nodes(TrNode_child(node));
@ -688,11 +710,13 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
node = trie_node_check_insert(node, PairEndTag); node = trie_node_check_insert(node, PairEndTag);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
return node; return node;
//return core_breadth_reduction(engine, node, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function); */
} }
while (IS_FUNCTOR_NODE(child)) { while (IS_FUNCTOR_NODE(child)) {
child = TrNode_child(child); child = TrNode_child(child);
if (IS_HASH_NODE(child)) { // gets first child in the hash if (IS_HASH_NODE(child)) { // gets first child in the hash
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) child; TrHash hash = (TrHash) child;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -702,35 +726,9 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} }
if (TrNode_child(child) == NULL) return NULL; if (TrNode_child(child) == NULL) return NULL;
if (TrNode_entry(TrNode_child(child)) != PairEndTag) return NULL; if (TrNode_entry(TrNode_child(child)) != PairEndTag) return NULL;
/* nested trie: stop procedure and return nested trie node */
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0))
/* TrNode temp = TrNode_child(child);
if (temp == NULL)
return NULL;
printf("Chosen start node child: "); displaynode(temp);
if (IS_HASH_NODE(temp)) {
TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) temp;
first_bucket = TrHash_buckets(hash);
bucket = first_bucket + TrHash_num_buckets(hash);
do {
if ((temp = *--bucket)) {
while((temp != NULL) && (TrNode_entry(temp) != PairEndTag)) {
temp = TrNode_next(temp);
}
}
} while (bucket != first_bucket && temp == NULL);
} else {
while((temp != NULL) && (TrNode_entry(temp) != PairEndTag))
temp = TrNode_next(temp);
}*/
// printf("while end\n");
//Nested Trie code
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) {
/* nested trie: stop procedure and return nested trie node */
return child; return child;
}
PUSH_DOWN(stack_args, TrNode_entry(child), stack_top); PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
count++; count++;
@ -816,7 +814,7 @@ int traverse_get_counter(TrNode node) {
YAP_Term generate_label(YAP_Int Index) { YAP_Term generate_label(YAP_Int Index) {
char label[20]; char label[20];
sprintf(label,"L" Int_FORMAT, Index); sprintf(label,"L%ld", Index);
return YAP_MkAtomTerm(YAP_LookupAtom(label)); return YAP_MkAtomTerm(YAP_LookupAtom(label));
} }
@ -968,3 +966,96 @@ YAP_Term update_depth_breadth_trie(TrEngine engine, TrNode root, YAP_Int opt_lev
YAP_Int core_db_trie_get_optimization_level_count(YAP_Int opt_level) { YAP_Int core_db_trie_get_optimization_level_count(YAP_Int opt_level) {
return TRIE_DEPTH_BREADTH_OPT_COUNT[opt_level - 1]; return TRIE_DEPTH_BREADTH_OPT_COUNT[opt_level - 1];
} }
/* -------------------------- */
/* Debug Procedures */
/* -------------------------- */
void displaynode(TrNode node) {
if (node != NULL) {
if (IS_HASH_NODE(node))
printf("HASH n%i, b%i, p%li\n", TrHash_num_nodes((TrHash) node), TrHash_num_buckets((TrHash) node), (long) node);
else if (TrNode_entry(node) == PairInitTag)
printf("PairInitTag\n");
else if (TrNode_entry(node) == PairEndTag)
printf("PairEndTag\n");
else if (IS_FUNCTOR_NODE(node))
printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
else if (YAP_IsIntTerm(TrNode_entry(node)))
printf("int(%ld)\n", YAP_IntOfTerm(TrNode_entry(node)));
else if (YAP_IsAtomTerm(TrNode_entry(node)))
printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
else
printf("What?\n");
} else
printf("null\n");
return;
}
void displayentry(TrNode node) {
printf("Entry Contains Bottom Up:\n");
while (node) {
displaynode(node);
node = TrNode_parent(node);
}
printf("--- End of Entry ---\n");
}
void displayterm(YAP_Term term) {
if (term) {
if (term == PairInitTag)
printf("PairInitTag\n");
else if (term == PairEndTag)
printf("PairEndTag\n");
else if (YAP_IsApplTerm(term))
printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & term))));
else if (YAP_IsIntTerm(term))
printf("int(%ld)\n", YAP_IntOfTerm(term));
else if (YAP_IsAtomTerm(term))
printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(term)));
else
printf("What?\n");
} else
printf("null\n");
return;
}
void displaytrie(TrNode node) {
while(TrNode_entry(node) != PairInitTag){
printf("?: "); displaynode(node);
node = TrNode_parent(node);
}
display_trie_inner(node);
}
void display_trie_inner(TrNode node) {
trie_display_node(node);
if (TrNode_entry(node) != PairEndTag && TrNode_child(node))
display_trie_inner(TrNode_child(node));
if (TrNode_next(node)) {
trie_display_node(TrNode_parent(node)); display_trie_inner(TrNode_next(node));
}
}
void trie_display_node(TrNode node) {
if (node != NULL) {
if (IS_HASH_NODE(node))
printf("HASH(n%i, b%i, p%li), ", TrHash_num_nodes((TrHash) node), TrHash_num_buckets((TrHash) node), (long) node);
else if (TrNode_entry(node) == PairInitTag)
printf("PairInitTag, ");
else if (TrNode_entry(node) == PairEndTag)
printf("PairEndTag\n");
else if (IS_FUNCTOR_NODE(node))
printf("functor(%s), ", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
else if (YAP_IsIntTerm(TrNode_entry(node)))
printf("int(%ld), ", YAP_IntOfTerm(TrNode_entry(node)));
else if (YAP_IsAtomTerm(TrNode_entry(node)))
printf("atom(%s), ", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
else
printf("What?\n");
} else
printf("null\n");
return;
}