rhs_value copy_rhs_value(agent* thisAgent, rhs_value rv, bool get_identity_set, bool get_cloned_identity)
{
cons* c = NULL, *new_c = NULL, *prev_new_c = NULL;
cons* fl=NULL, *new_fl=NULL;
if (!rv) {
return NULL;
} else if ((rhs_value_is_reteloc(rv)) || (rhs_value_is_unboundvar(rv)))
{
return rv;
} else if (rhs_value_is_funcall(rv))
{
fl = rhs_value_to_funcall_list(rv);
allocate_cons(thisAgent, &new_fl);
new_fl->first = fl->first;
prev_new_c = new_fl;
for (c = fl->rest; c != NIL; c = c->rest)
{
allocate_cons(thisAgent, &new_c);
new_c->first = copy_rhs_value(thisAgent, static_cast<char*>(c->first), get_identity_set, get_cloned_identity);
prev_new_c->rest = new_c;
prev_new_c = new_c;
}
prev_new_c->rest = NIL;
return funcall_list_to_rhs_value(new_fl);
}
else
{
rhs_symbol r = rhs_value_to_rhs_symbol(rv);
uint64_t lID = r->inst_identity;
Identity* l_identity = r->identity;
if (get_identity_set)
{
if (l_identity)
{
if (l_identity->get_clone_identity())
{
assert(false);
l_identity = thisAgent->explanationBasedChunker->get_identity_for_id(l_identity->get_clone_identity());
}
else
{
l_identity = thisAgent->explanationBasedChunker->get_identity_for_id(l_identity->get_identity());
}
}
else if (lID)
l_identity = thisAgent->explanationBasedChunker->get_identity_for_id(lID);
}
if (l_identity && get_cloned_identity)
{
lID = l_identity->get_clone_identity();
l_identity = NULL_IDENTITY_SET; // Will be filled in later based when finalizing
}
return allocate_rhs_value_for_symbol(thisAgent, r->referent, lID, r->cv_id, l_identity, r->was_unbound_var);
}
}
memptr func_list(memptr func_expr) {
if (num_nodes(func_expr) == 1) {
return nil;
}
memptr current_node, current_param, current_dup_node = safe_allocate_cons(),
base = current_dup_node;
cons_pool[current_dup_node].carKind = NIL;
cons_pool[current_dup_node].cdrKind = NIL;
current_node = cons_pool[func_expr].cdr;
current_param = resolve_expr(cons_pool[current_node].car);
if (current_param == NOT_FOUND) {
#ifdef DEBUG
printf("29\n");
#endif
ERROR(ERROR_LIST, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
} else if (type(current_param) == TYPE_OBJECT) {
memptr lu = object_lookup(current_param, cons_pool[func_expr].car);
if (lu != NOT_FOUND) {
#ifdef EXTENDED_SECURITY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].car = current_param;
cons_pool[local_security].carKind = CONS;
cons_pool[local_security].cdrKind = NIL;
#endif
return resolve_func_expr(func_expr, current_param, lu, true);
}
}
cons_pool[current_dup_node].car = current_param;
cons_pool[current_dup_node].carKind = CONS;
while (cons_pool[current_node].cdrKind == CONS) {
current_node = cons_pool[current_node].cdr;
cons_pool[current_dup_node].cdr = allocate_cons();
cons_pool[current_dup_node].cdrKind = CONS;
current_dup_node = cons_pool[current_dup_node].cdr;
cons_pool[current_dup_node].carKind = NIL;
cons_pool[current_dup_node].cdrKind = NIL;
current_param = resolve_expr(cons_pool[current_node].car);
if (current_param == NOT_FOUND) {
#ifdef DEBUG
printf("30\n");
#endif
ERROR(ERROR_LIST, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
cons_pool[current_dup_node].car = current_param;
cons_pool[current_dup_node].carKind = CONS;
}
cons_pool[current_dup_node].cdrKind = CONS;
cons_pool[current_dup_node].cdr = nil;
return base;
}
void object_insert_symbol(memptr object, memptr symbol) {
memptr new_head, temp;
if (cons_pool[object].cdr == nil) {
cons_pool[object].cdr = allocate_cons();
new_head = cons_pool[object].cdr;
cons_pool[new_head].car = symbol;
cons_pool[new_head].carKind = CONS;
cons_pool[new_head].cdrKind = NIL;
} else {
temp = cons_pool[object].cdr;
cons_pool[object].cdr = allocate_cons();
new_head = cons_pool[object].cdr;
cons_pool[new_head].car = symbol;
cons_pool[new_head].carKind = CONS;
cons_pool[new_head].cdr = temp;
cons_pool[new_head].cdrKind = CONS;
}
}
list *add_if_not_member (agent* thisAgent, void *item, list *old_list) {
cons *c;
for (c=old_list; c!=NIL; c=c->rest)
if (c->first==item) return old_list;
allocate_cons (thisAgent, &c);
c->first = item;
c->rest = old_list;
return c;
}
memptr func_cdr(memptr func_expr) {
if (num_nodes(func_expr) != 2) {
#ifdef DEBUG
printf("12\n");
#endif
ERROR(ERROR_CDR, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr param = resolve_expr(cons_pool[cons_pool[func_expr].cdr].car);
cons_pool[local_security].car = param;
cons_pool[local_security].carKind = CONS;
while (true) {
Type param_type = type(param);
if (param_type == TYPE_CONS) {
return cons_pool[param].cdr;
} else if (param_type == TYPE_STRING) {
memptr result;
if ((cons_pool[param].cdr < 0) || (string_length(param) == 1)) {
result = nil;
} else {
result = allocate_cons();
cons_pool[result].car = cons_pool[param].car;
cons_pool[result].cdr = cons_pool[param].cdr + 1;
cons_pool[result].carKind = STRING;
cons_pool[result].cdrKind = INTEGER;
}
return result;
} else if (param_type == TYPE_OBJECT) {
memptr lu = object_lookup(param, cons_pool[func_expr].car);
if (lu == NOT_FOUND) {
param = object_lookup(param, core_symbol);
continue;
} else {
return resolve_func_expr(func_expr, param, lu, true);
}
}
break;
}
#ifdef DEBUG
printf("13\n");
#endif
ERROR(ERROR_CDR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
memptr func_defun(memptr func_expr) {
if (num_nodes(func_expr) != 4) {
#ifdef DEBUG
printf("25\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr name = cons_pool[cons_pool[func_expr].cdr].car;
if (cons_pool[name].carKind != STRING || cons_pool[name].cdrKind != CONS) {
// first argument not a name
#ifdef DEBUG
printf("26\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr parameters = cons_pool[cons_pool[cons_pool[func_expr].cdr].cdr].car;
if (parameters != nil) {
if (cons_pool[parameters].carKind != CONS
|| cons_pool[parameters].cdrKind != NIL) {
// second argument not a parameters list
#ifdef DEBUG
printf("27\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr current_param_node, next_param_node = cons_pool[parameters].car,
current_param;
// function has parameter(s)
do {
current_param_node = next_param_node;
current_param = cons_pool[current_param_node].car;
if (cons_pool[current_param].carKind != STRING
|| cons_pool[current_param].cdrKind != CONS) {
// a parameter is not a name
#ifdef DEBUG
printf("28\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
next_param_node = cons_pool[next_param_node].cdr;
} while (cons_pool[current_param_node].cdrKind == CONS);
}
// now we can build the function representation in the memory pool,
// and connect the functions name to it
memptr function = safe_allocate_cons(), current;
cons_pool[function].car = cons_pool[name].car;
cons_pool[function].carKind = STRING;
cons_pool[function].cdr = allocate_cons();
cons_pool[function].cdrKind = CONS;
// the name value - a user function
current = cons_pool[function].cdr;
cons_pool[current].car = allocate_cons();
cons_pool[current].carKind = CONS;
cons_pool[current].cdrKind = NIL;
// first argument - parameters list
current = cons_pool[current].car;
cons_pool[current].car = (
parameters == nil ? nil : cons_pool[parameters].car);
cons_pool[current].carKind = CONS;
cons_pool[current].cdr = allocate_cons();
cons_pool[current].cdrKind = CONS;
// second argument - function body
current = cons_pool[current].cdr;
cons_pool[current].carKind = CONS;
cons_pool[current].cdrKind = NIL;
cons_pool[current].car =
cons_pool[cons_pool[cons_pool[cons_pool[func_expr].cdr].cdr].cdr].car;
#ifdef DEFUN_SECURE_BODY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].car = cons_pool[current].car;
cons_pool[local_security].carKind = CONS;
cons_pool[local_security].cdrKind = NIL;
#endif
// hashing the function into the system
memptr env = lookup(function, ENVIRONMENT);
if (env == NOT_FOUND) {
// inserting to current environment
insert_symbol(environment, function);
} else {
// replacing previous interpretation
remove_symbol(env, function);
insert_symbol(env, function);
}
return cons_pool[function].cdr;
}
memptr func_setq(memptr func_expr) {
if (num_nodes(func_expr) != 3) {
// invalid call
#ifdef DEBUG
printf("22\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr current_node = cons_pool[func_expr].cdr;
memptr current_param = cons_pool[current_node].car;
Type first_type = type(current_param);
if (first_type != TYPE_SYMBOL) {
// first argument not a name
#ifdef DEBUG
printf("23\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr symbol_name = current_param;
current_node = cons_pool[current_node].cdr;
current_param = cons_pool[current_node].car;
memptr value = resolve_expr(current_param);
if (value == NOT_FOUND) {
// invalid value
#ifdef DEBUG
printf("24\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
cons_pool[local_security].car = value;
cons_pool[local_security].carKind = CONS;
// defining the new symbol
memptr symbol = allocate_cons();
cons_pool[local_security].cdr = symbol;
cons_pool[local_security].cdrKind = CONS;
cons_pool[symbol].car = cons_pool[symbol_name].car;
cons_pool[symbol].carKind = STRING;
cons_pool[symbol].cdr = value;
cons_pool[symbol].cdrKind = CONS;
memptr env = lookup(symbol, ENVIRONMENT);
if (env == NOT_FOUND) {
// inserting to current environment
insert_symbol(environment, symbol); // includes 1 allocation
} else {
// replacing previous interpretation
remove_symbol(env, symbol);
insert_symbol(env, symbol); // includes 1 allocation
}
return value;
}
memptr do_join_operation(memptr func_expr, JoinOperation operation_type) {
if (num_nodes(func_expr) != 3) {
#ifdef DEBUG
printf("1\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
break;
default:
break;
}
return NOT_FOUND;
}
memptr current_node = cons_pool[func_expr].cdr;
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr first_param = resolve_expr(cons_pool[current_node].car);
if (first_param == NOT_FOUND) {
#ifdef DEBUG
printf("2\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
cons_pool[local_security].car = first_param;
cons_pool[local_security].carKind = CONS;
Type first_param_type = type(first_param);
if (first_param_type == TYPE_OBJECT) {
memptr lu = object_lookup(first_param, cons_pool[func_expr].car);
if (lu == NOT_FOUND) {
first_param = object_lookup(first_param, core_symbol);
first_param_type = type(first_param);
} else {
return resolve_func_expr(func_expr, first_param, lu, true);
}
}
current_node = cons_pool[current_node].cdr;
memptr second_param = resolve_expr(cons_pool[current_node].car);
if (second_param == NOT_FOUND) {
#ifdef DEBUG
printf("3\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
cons_pool[local_security].cdr = second_param;
cons_pool[local_security].cdrKind = CONS;
Type second_param_type = type(second_param);
if (second_param_type == TYPE_OBJECT) {
second_param = object_lookup(second_param, core_symbol);
second_param_type = type(second_param);
}
memptr result = NOT_FOUND;
if (operation_type == PLUS || operation_type == MINUS
|| operation_type == MULT || operation_type == DIV) {
if (first_param_type != TYPE_INTEGER
|| second_param_type != TYPE_INTEGER) {
#ifdef DEBUG
printf("4\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
int first_value = fix_integer(cons_pool[first_param].car);
int second_value = fix_integer(cons_pool[second_param].car);
result = allocate_cons();
cons_pool[result].carKind = INTEGER;
cons_pool[result].cdrKind = NIL;
switch (operation_type) {
case PLUS:
cons_pool[result].car = first_value + second_value;
break;
case MINUS:
cons_pool[result].car = first_value - second_value;
break;
case MULT:
cons_pool[result].car = first_value * second_value;
break;
case DIV:
if (second_value == 0) {
#ifdef DEBUG
printf("5\n");
#endif
return NOT_FOUND;
}
cons_pool[result].car = first_value / second_value;
break;
default:
break;
}
} else if (operation_type == EQUAL || operation_type == SMALLER
|| operation_type == GREATER) {
if (first_param_type != second_param_type) {
#ifdef DEBUG
printf("6\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
}
int first_value;
int second_value;
if (first_param_type == TYPE_NIL_TRUE) {
first_value = ((first_param == nil) ? 0 : 1);
second_value = ((second_param == nil) ? 0 : 1);
} else if (first_param_type == TYPE_INTEGER) {
first_value = fix_integer(cons_pool[first_param].car);
second_value = fix_integer(cons_pool[second_param].car);
} else {
// addresses comparison
first_value = first_param;
second_value = second_param;
}
// strings logic
if (first_param_type == TYPE_STRING) {
bool full_equal = false;
int len1 = string_length(first_param);
int len2 = string_length(second_param);
if ((len1 == 1) || (len2 == 1)) {
first_value =
strings_pool[get_string(cons_pool[first_param].car,
cons_pool[first_param].cdr)];
second_value = strings_pool[get_string(
cons_pool[second_param].car,
cons_pool[second_param].cdr)];
if (len1 != 1) {
if (first_value == second_value) {
first_value++;
}
}
if (len2 != 1) {
if (first_value == second_value) {
second_value++;
}
}
} else {
int iter1 = get_string(cons_pool[first_param].car,
cons_pool[first_param].cdr), iter2 = get_string(
cons_pool[second_param].car,
cons_pool[second_param].cdr);
first_value = second_value = 0;
while (first_value == second_value
&& strings_pool[iter1] != '\0'
&& strings_pool[iter2] != '\0') {
first_value = strings_pool[iter1++];
second_value = strings_pool[iter2++];
}
if ((strings_pool[iter1] != '\0')
&& (strings_pool[iter2] == '\0')
&& (first_value == second_value)) {
first_value++;
} else if ((strings_pool[iter1] == '\0')
&& (strings_pool[iter2] != '\0')
&& (first_value == second_value)) {
second_value++;
}
}
}
switch (operation_type) {
case EQUAL:
result = ((first_value == second_value) ? t : nil);
break;
case SMALLER:
result = ((first_value < second_value) ? t : nil);
break;
case GREATER:
result = ((first_value > second_value) ? t : nil);
break;
default:
#ifdef DEBUG
printf("7\n");
#endif
return NOT_FOUND;
break;
}
} else if (operation_type == XOR || operation_type == OR
|| operation_type == AND) {
if (first_param_type != TYPE_NIL_TRUE
|| second_param_type != TYPE_NIL_TRUE) {
#ifdef DEBUG
printf("7.5\n");
#endif
switch (operation_type) {
case PLUS:
ERROR(ERROR_PLUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MINUS:
ERROR(ERROR_MINUS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case MULT:
ERROR(ERROR_MULT, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case DIV:
ERROR(ERROR_DIV, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case EQUAL:
ERROR(ERROR_EQUALS, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case SMALLER:
ERROR(ERROR_SMALLER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case GREATER:
ERROR(ERROR_GREATER, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case OR:
ERROR(ERROR_OR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case AND:
ERROR(ERROR_AND, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
case XOR:
ERROR(ERROR_XOR, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
break;
default:
break;
}
return NOT_FOUND;
}
switch (operation_type) {
case XOR:
result = ((first_param != second_param) ? t : nil);
break;
case OR:
result = ((first_param == t || second_param == t) ? t : nil);
break;
case AND:
result = ((first_param == t && second_param == t) ? t : nil);
break;
default:
#ifdef DEBUG
printf("8\n");
#endif
return NOT_FOUND;
break;
}
}
return result;
}
memptr func_assign(memptr func_expr) {
if (num_nodes(func_expr) != 4) {
#ifdef DEBUG
printf("33\n");
#endif
ERROR(ERROR_ASSIGN, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr current_node = cons_pool[func_expr].cdr;
memptr symbol = cons_pool[current_node].car;
current_node = cons_pool[current_node].cdr;
memptr value = cons_pool[current_node].car;
current_node = cons_pool[current_node].cdr;
memptr obj = cons_pool[current_node].car;
// first resolve the object, then the value
obj = resolve_expr(obj);
if (obj == NOT_FOUND) {
#ifdef DEBUG
printf("34\n");
#endif
ERROR(ERROR_ASSIGN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
cons_pool[local_security].car = obj;
cons_pool[local_security].carKind = CONS;
value = resolve_expr(value);
if (value == NOT_FOUND) {
#ifdef DEBUG
printf("35\n");
#endif
ERROR(ERROR_ASSIGN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
cons_pool[local_security].cdr = value;
cons_pool[local_security].cdrKind = CONS;
memptr result = NOT_FOUND;
if (type(obj) == TYPE_OBJECT) {
announce_allocation(2);
memptr new_symbol = allocate_cons();
cons_pool[new_symbol].car = cons_pool[symbol].car;
cons_pool[new_symbol].carKind = STRING;
cons_pool[new_symbol].cdr = value;
cons_pool[new_symbol].cdrKind = CONS;
object_remove_symbol(obj, new_symbol);
object_insert_symbol(obj, new_symbol); // includes 1 allocation
result = obj;
} else {
announce_allocation(5);
memptr new_obj = allocate_cons();
cons_pool[new_obj].carKind = NIL;
cons_pool[new_obj].cdr = allocate_cons();
cons_pool[new_obj].cdrKind = CONS;
memptr new_node = cons_pool[new_obj].cdr;
cons_pool[new_node].car = allocate_cons();
cons_pool[new_node].carKind = CONS;
cons_pool[new_node].cdr = allocate_cons();
cons_pool[new_node].cdrKind = CONS;
memptr new_symbol = cons_pool[new_node].car;
cons_pool[new_symbol].car = cons_pool[symbol].car;
cons_pool[new_symbol].carKind = STRING;
cons_pool[new_symbol].cdr = value;
cons_pool[new_symbol].cdrKind = CONS;
memptr new_core_node = cons_pool[new_node].cdr;
cons_pool[new_core_node].cdrKind = NIL;
cons_pool[new_core_node].car = allocate_cons();
cons_pool[new_core_node].carKind = CONS;
memptr new_core_symbol = cons_pool[new_core_node].car;
cons_pool[new_core_symbol].car = cons_pool[core_symbol].car;
cons_pool[new_core_symbol].carKind = STRING;
cons_pool[new_core_symbol].cdr = obj;
cons_pool[new_core_symbol].cdrKind = CONS;
result = new_obj;
}
return result;
}
rhs_value create_RHS_value(agent* thisAgent,
rhs_value rv,
condition* cond,
char first_letter,
ExplainTraceType ebcTraceType)
{
cons* c, *new_c, *prev_new_c;
cons* fl, *new_fl;
Symbol* sym;
int64_t index;
char prefix[2];
test t;//, original_t;
uint64_t lO_id = 0;
/* (1) Reteloc identifiers or constants originally bound to variables
* (2) unbound_vars for unbound vars of course
* (3) rhs_symbols for literal constants, including those in RHS functions */
if (rhs_value_is_reteloc(rv))
{
/* Symbol pointed to by a rete location
* This case seems to only be for identifiers or constants originally bound to variables */
t = var_test_bound_in_reconstructed_conds(thisAgent, cond,
rhs_value_to_reteloc_field_num(rv),
rhs_value_to_reteloc_levels_up(rv));
return allocate_rhs_value_for_symbol(thisAgent, t->data.referent, t->inst_identity, 0, t->identity);
}
if (rhs_value_is_unboundvar(rv))
{
/* Unbound variable */
index = static_cast<int64_t>(rhs_value_to_unboundvar(rv));
if (! *(thisAgent->rhs_variable_bindings + index))
{
prefix[0] = first_letter;
prefix[1] = 0;
sym = thisAgent->symbolManager->generate_new_variable(prefix);
*(thisAgent->rhs_variable_bindings + index) = sym;
if (thisAgent->highest_rhs_unboundvar_index < index)
{
thisAgent->highest_rhs_unboundvar_index = index;
}
if (ebcTraceType == Explanation_Trace)
{
lO_id = thisAgent->explanationBasedChunker->get_or_create_inst_identity_for_sym(sym);
}
/* generate will increment the refcount on the new variable, so don't need to do it here. */
return allocate_rhs_value_for_symbol_no_refcount(thisAgent, sym, lO_id, 0, NULL, true);
}
else
{
/* unbound variable was already created in previous rhs action */
sym = *(thisAgent->rhs_variable_bindings + index);
}
if (ebcTraceType == Explanation_Trace)
{
lO_id = thisAgent->explanationBasedChunker->get_or_create_inst_identity_for_sym(sym);
}
return allocate_rhs_value_for_symbol(thisAgent, sym, lO_id, 0, NULL, true);
}
if (rhs_value_is_funcall(rv))
{
fl = rhs_value_to_funcall_list(rv);
allocate_cons(thisAgent, &new_fl);
new_fl->first = fl->first;
prev_new_c = new_fl;
for (c = fl->rest; c != NIL; c = c->rest)
{
allocate_cons(thisAgent, &new_c);
new_c->first = create_RHS_value(thisAgent,
static_cast<char*>(c->first),
cond,
first_letter,
ebcTraceType);
prev_new_c->rest = new_c;
prev_new_c = new_c;
}
prev_new_c->rest = NIL;
return funcall_list_to_rhs_value(new_fl);
}
else
{
/* Literal values including those in function calls. */
rhs_symbol rs = rhs_value_to_rhs_symbol(rv);
if (ebcTraceType == Explanation_Trace)
return allocate_rhs_value_for_symbol(thisAgent, rs->referent, rs->inst_identity, rs->cv_id, rs->identity, rs->was_unbound_var);
else
return allocate_rhs_value_for_symbol(thisAgent, rs->referent, LITERAL_VALUE, 0, NULL, rs->was_unbound_var);
}
}
Symbol *instantiate_rhs_value (rhs_value rv, goal_stack_level new_id_level,
char new_id_letter,
struct token_struct *tok, wme *w) {
list *fl;
list *arglist;
cons *c, *prev_c, *arg_cons;
rhs_function *rf;
Symbol *result;
bool nil_arg_found;
if (rhs_value_is_symbol(rv)) {
result = rhs_value_to_symbol(rv);
symbol_add_ref (result);
return result;
}
if (rhs_value_is_unboundvar(rv)) {
long index;
Symbol *sym;
index = rhs_value_to_unboundvar(rv);
if (firer_highest_rhs_unboundvar_index < index)
firer_highest_rhs_unboundvar_index = index;
sym = *(current_agent(rhs_variable_bindings)+index);
if (!sym) {
sym = make_new_identifier (new_id_letter, new_id_level);
*(current_agent(rhs_variable_bindings)+index) = sym;
return sym;
} else if (sym->common.symbol_type==VARIABLE_SYMBOL_TYPE) {
new_id_letter = *(sym->var.name + 1);
sym = make_new_identifier (new_id_letter, new_id_level);
*(current_agent(rhs_variable_bindings)+index) = sym;
return sym;
} else {
symbol_add_ref (sym);
return sym;
}
}
if (rhs_value_is_reteloc(rv)) {
result = get_symbol_from_rete_loc ((unsigned short) rhs_value_to_reteloc_levels_up(rv),
(byte)rhs_value_to_reteloc_field_num(rv),
tok, w);
symbol_add_ref (result);
return result;
}
fl = rhs_value_to_funcall_list(rv);
rf = fl->first;
/* --- build up a list of the argument values --- */
prev_c = NIL;
nil_arg_found = FALSE;
arglist = NIL; /* unnecessary, but gcc -Wall warns without it */
for (arg_cons=fl->rest; arg_cons!=NIL; arg_cons=arg_cons->rest) {
allocate_cons (&c);
c->first = instantiate_rhs_value (arg_cons->first, new_id_level,
new_id_letter, tok, w);
if (! c->first) nil_arg_found = TRUE;
if (prev_c) prev_c->rest = c; else arglist = c;
prev_c = c;
}
if (prev_c) prev_c->rest = NIL; else arglist = NIL;
/* --- if all args were ok, call the function --- */
if (!nil_arg_found)
result = (*(rf->f))(arglist);
else
result = NIL;
/* --- scan through arglist, dereference symbols and deallocate conses --- */
for (c=arglist; c!=NIL; c=c->rest)
if (c->first) symbol_remove_ref ((Symbol *)(c->first));
free_list (arglist);
return result;
}
saved_test *simplify_test (agent* thisAgent, test *t, saved_test *old_sts) {
test New, subtest;
saved_test *saved;
Symbol *var, *sym;
cons *c, *prev_c, *next_c;
complex_test *ct;
if (test_is_blank_test(*t)) {
sym = generate_new_variable (thisAgent, "dummy-");
*t = make_equality_test_without_adding_reference (sym);
return old_sts;
}
if (test_is_blank_or_equality_test(*t)) {
return old_sts;
}
ct = complex_test_from_test(*t);
switch (ct->type) {
case CONJUNCTIVE_TEST:
/* --- look at subtests for an equality test --- */
sym = NIL;
for (c=ct->data.conjunct_list; c!=NIL; c=c->rest) {
subtest = static_cast<char *>(c->first);
if (test_is_blank_or_equality_test(subtest))
sym = referent_of_equality_test(subtest);
}
/* --- if no equality test was found, generate a variable for it --- */
if (!sym) {
sym = generate_new_variable (thisAgent, "dummy-");
New = make_equality_test_without_adding_reference (sym);
allocate_cons (thisAgent, &c);
c->first = New;
c->rest = ct->data.conjunct_list;
ct->data.conjunct_list = c;
}
/* --- scan through, create saved_test for subtests except equality --- */
prev_c = NIL;
c = ct->data.conjunct_list;
while (c) {
next_c = c->rest;
subtest = static_cast<char *>(c->first);
if (! test_is_blank_or_equality_test(subtest)) {
/* --- create saved_test, splice this cons out of conjunct_list --- */
allocate_with_pool (thisAgent, &thisAgent->saved_test_pool, &saved);
saved->next = old_sts;
old_sts = saved;
saved->var = sym;
symbol_add_ref (sym);
saved->the_test = subtest;
if (prev_c)
prev_c->rest = next_c;
else
ct->data.conjunct_list = next_c;
free_cons (thisAgent, c);
} else {
prev_c = c;
}
c = next_c;
}
break;
default:
/* --- goal/impasse, disjunction, and non-equality relational tests --- */
var = generate_new_variable (thisAgent, "dummy-");
New = make_equality_test_without_adding_reference (var);
allocate_with_pool (thisAgent, &thisAgent->saved_test_pool, &saved);
saved->next = old_sts;
old_sts = saved;
saved->var = var;
symbol_add_ref (var);
saved->the_test = *t;
*t = New;
break;
}
return old_sts;
}
