/**
* CTRMessageSend
*
* Sends a message to a receiver object.
*/
ctr_object* ctr_send_message(ctr_object* receiverObject, char* message, long vlen, ctr_argument* argumentList) {
char toParent = 0;
ctr_object* me;
ctr_object* methodObject;
ctr_object* searchObject;
ctr_argument* argCounter;
ctr_argument* mesgArgument;
ctr_object* result;
ctr_object* (*funct)(ctr_object* receiverObject, ctr_argument* argumentList);
int argCount;
if (CtrStdError != NULL) return NULL; /* Error mode, ignore subsequent messages until resolved. */
methodObject = NULL;
searchObject = receiverObject;
if (vlen > 1 && message[0] == '`') {
me = ctr_internal_object_find_property(ctr_contexts[ctr_context_id], ctr_build_string_from_cstring("me\0"), 0);
if (searchObject == me) {
toParent = 1;
message = message + 1;
vlen--;
}
}
while(!methodObject) {
methodObject = ctr_internal_object_find_property(searchObject, ctr_build_string(message, vlen), 1);
if (methodObject && toParent) { toParent = 0; methodObject = NULL; }
if (methodObject) break;
if (!searchObject->link) break;
searchObject = searchObject->link;
}
if (!methodObject) {
argCounter = argumentList;
argCount = 0;
while(argCounter->next && argCount < 4) {
argCounter = argCounter->next;
argCount ++;
}
mesgArgument = CTR_CREATE_ARGUMENT();
mesgArgument->object = ctr_build_string(message, vlen);
mesgArgument->next = argumentList;
if (argCount == 0 || argCount > 2) {
return ctr_send_message(receiverObject, "respondTo:", 10, mesgArgument);
} else if (argCount == 1) {
return ctr_send_message(receiverObject, "respondTo:with:", 15, mesgArgument);
} else if (argCount == 2) {
return ctr_send_message(receiverObject, "respondTo:with:and:", 19, mesgArgument);
}
}
if (methodObject->info.type == CTR_OBJECT_TYPE_OTNATFUNC) {
funct = methodObject->value.fvalue;
result = funct(receiverObject, argumentList);
}
if (methodObject->info.type == CTR_OBJECT_TYPE_OTBLOCK) {
result = ctr_block_run(methodObject, argumentList, receiverObject);
}
return result;
}
/**
* [Map] at: [Key]
*
* Retrieves the value specified by the key from the map.
*
* In other languages:
* Dutch: [Lijst] bij: [Object] | Geeft de waarde bij de bijbehorende sleutel.
*/
ctr_object* ctr_map_get(ctr_object* myself, ctr_argument* argumentList) {
ctr_argument* emptyArgumentList;
ctr_object* searchKey;
ctr_object* foundObject;
emptyArgumentList = ctr_heap_allocate(sizeof(ctr_argument));
emptyArgumentList->next = NULL;
emptyArgumentList->object = NULL;
searchKey = argumentList->object;
/* Give developer a chance to define a key for array */
searchKey = ctr_send_message(searchKey, CTR_DICT_TOSTRING, strlen(CTR_DICT_TOSTRING), emptyArgumentList);
ctr_heap_free( emptyArgumentList );
/* If developer returns something other than string (ouch, toString), then cast anyway */
if (searchKey->info.type != CTR_OBJECT_TYPE_OTSTRING) {
searchKey = ctr_internal_cast2string(searchKey);
}
foundObject = ctr_internal_object_find_property(myself, searchKey, 0);
if (foundObject == NULL) foundObject = ctr_build_nil();
return foundObject;
}
/**
* [Map] put: [Element] at: [Key]
*
* Puts a key-value pair in a map.
*
* Usage:
*
* map put: 'hello' at: 'world'.
*
* In other languages:
* Dutch: [Lijst] zet: [Object] bij: [Object]
* Zet het gespecificeerde object element bij de plek die bekend staat als
* het andere object. Net als bij een reeks, alleen in dit geval is het tweede
* Object de sleutel waarmee het eerste object weer uit de lijst gevist kan
* worden.
*/
ctr_object* ctr_map_put(ctr_object* myself, ctr_argument* argumentList) {
char* key;
long keyLen;
ctr_object* putKey;
ctr_object* putValue = argumentList->object;
ctr_argument* nextArgument = argumentList->next;
ctr_argument* emptyArgumentList = ctr_heap_allocate(sizeof(ctr_argument));
emptyArgumentList->next = NULL;
emptyArgumentList->object = NULL;
putKey = ctr_send_message(nextArgument->object, CTR_DICT_TOSTRING, strlen(CTR_DICT_TOSTRING), emptyArgumentList);
/* If developer returns something other than string (ouch, toString), then cast anyway */
if (putKey->info.type != CTR_OBJECT_TYPE_OTSTRING) {
putKey = ctr_internal_cast2string(putKey);
}
key = ctr_heap_allocate( putKey->value.svalue->vlen * sizeof( char ) );
keyLen = putKey->value.svalue->vlen;
memcpy(key, putKey->value.svalue->value, keyLen);
ctr_internal_object_delete_property(myself, ctr_build_string(key, keyLen), 0);
ctr_internal_object_add_property(myself, ctr_build_string(key, keyLen), putValue, 0);
ctr_heap_free( emptyArgumentList );
ctr_heap_free( key );
return myself;
}
/**
* [List] by: [List].
*
* Combines the first list with the second one, thus creating
* a map. The keys of the newly generated map will be provided by the
* first list while the values are extracted from the second one.
* In the example we derive a temperature map from a pair of lists
* (cities and temperatures).
*
* Usage:
*
* ☞ city := List ← 'London' ; 'Paris' ; 'Berlin'.
* ☞ temperature := List ← '15' ; '16' ; '15'.
* ☞ weather := temperature by: city.
*
* In other languages:
* Dutch: [Reeks] per: [Reeks]
* Maakt een Lijst door elementen uit de eerste reeks te koppelen
* aan de elementen op dezelfde plek uit de tweede reeks.
*/
ctr_object* ctr_array_combine(ctr_object* myself, ctr_argument* argumentList) {
ctr_size i;
ctr_object* map = ctr_map_new( CtrStdMap, argumentList );
if (argumentList->object->info.type != CTR_OBJECT_TYPE_OTARRAY) {
return map;
}
ctr_argument* key = ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* value = ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* index = ctr_heap_allocate( sizeof( ctr_argument ) );
for(i = myself->value.avalue->tail; i<myself->value.avalue->head; i++) {
index->object = ctr_build_number_from_float((ctr_number) i);
key->object = ctr_array_get( myself, index );
value->object = ctr_array_get( argumentList->object, index );
key->next = value;
ctr_send_message( map, CTR_DICT_PUT_AT, strlen(CTR_DICT_PUT_AT), key);
ctr_map_put( map, key );
}
ctr_heap_free(key);
ctr_heap_free(value);
ctr_heap_free(index);
return map;
}
/**
* CTRWalkerMessage
*
* Processes a message sending operation.
*/
ctr_object *
ctr_cwlk_message (ctr_tnode * paramNode)
{
int sticky = 0;
char wasReturn = 0;
ctr_object *result;
ctr_tlistitem *eitem = paramNode->nodes;
ctr_tnode *receiverNode = eitem->node;
ctr_tnode *msgnode;
ctr_tlistitem *li = eitem;
char *message;
ctr_tlistitem *argumentList;
ctr_object *r;
ctr_object *recipientName = NULL;
switch (receiverNode->type)
{
case CTR_AST_NODE_REFERENCE:
recipientName = ctr_build_string (receiverNode->value, receiverNode->vlen);
recipientName->info.sticky = 1;
if (CtrStdFlow == NULL)
{
ctr_callstack[ctr_callstack_index++] = receiverNode;
}
if (receiverNode->modifier == 1 || receiverNode->modifier == 3)
{
r = ctr_find_in_my (recipientName);
}
else
{
r = ctr_find (recipientName);
}
if (CtrStdFlow == NULL)
{
ctr_callstack_index--;
}
if (!r)
{
exit (1);
}
break;
case CTR_AST_NODE_LTRNIL:
r = ctr_build_nil ();
break;
case CTR_AST_NODE_LTRBOOLTRUE:
r = ctr_build_bool (1);
break;
case CTR_AST_NODE_LTRBOOLFALSE:
r = ctr_build_bool (0);
break;
case CTR_AST_NODE_LTRSTRING:
r = ctr_build_string (receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_LTRNUM:
r = ctr_build_number_from_string (receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_IMMUTABLE:
case CTR_AST_NODE_NESTED:
r = ctr_cwlk_expr (receiverNode, &wasReturn);
break;
case CTR_AST_NODE_CODEBLOCK:
r = ctr_build_block (receiverNode);
break;
case CTR_AST_NODE_SYMBOL:
r = (ctr_object *) (receiverNode->value);
break;
default:
printf ("Cannot send messages to receiver of type: %d \n", receiverNode->type);
break;
}
while (li->next)
{
ctr_argument *a;
ctr_argument *aItem;
ctr_size l;
li = li->next;
msgnode = li->node;
message = msgnode->value;
l = msgnode->vlen;
if (CtrStdFlow == NULL)
{
ctr_callstack[ctr_callstack_index++] = msgnode;
}
argumentList = msgnode->nodes;
a = (ctr_argument *) ctr_heap_allocate (sizeof (ctr_argument));
aItem = a;
aItem->object = CtrStdNil;
if (argumentList)
{
ctr_tnode *node;
while (argumentList)
{
node = argumentList->node;
if (!node)
goto next;
aItem->object = ctr_cwlk_expr (node, &wasReturn);
/* we always send at least one argument, note that if you want to modify the argumentList, be sure to take this into account */
/* there is always an extra empty argument at the end */
aItem->next = ctr_heap_allocate (sizeof (ctr_argument));
aItem = aItem->next;
next:;
aItem->object = NULL;
argumentList = argumentList->next;
}
}
sticky = r->info.sticky;
r->info.sticky = 1;
result = ctr_send_message (r, message, l, a);
r->info.sticky = sticky;
aItem = a;
if (CtrStdFlow == NULL)
{
ctr_callstack_index--;
}
while (aItem->next)
{
a = aItem;
aItem = aItem->next;
ctr_heap_free (a);
}
ctr_heap_free (aItem);
r = result;
}
if (recipientName)
recipientName->info.sticky = 0;
return result;
}
/**
* CTRWalkerMessage
*
* Processes a message sending operation.
*/
ctr_object* ctr_cwlk_message(ctr_tnode* paramNode) {
int sticky = 0;
char wasReturn = 0;
int literal = 1;
ctr_object* keys[40];
int key_index = 0;
ctr_object* result;
ctr_tlistitem* eitem = paramNode->nodes;
ctr_tnode* receiverNode = eitem->node;
ctr_tnode* msgnode;
ctr_tlistitem* li = eitem;
char* message;
ctr_tlistitem* argumentList;
ctr_object* r;
ctr_object* recipientName = NULL;
if (ctr_flag_sandbox && ++ctr_sandbox_steps>CTR_MAX_STEPS_LIMIT) exit(1);
switch (receiverNode->type) {
case CTR_AST_NODE_REFERENCE:
literal = 0;
recipientName = ctr_build_string(receiverNode->value, receiverNode->vlen);
recipientName->info.sticky = 1;
if (CtrStdFlow == NULL) {
ctr_callstack[ctr_callstack_index++] = receiverNode;
}
if (receiverNode->modifier == 1) {
r = ctr_find_in_my(recipientName);
} else {
r = ctr_find(recipientName);
}
if (CtrStdFlow == NULL) {
ctr_callstack_index--;
}
if (!r) {
exit(1);
}
break;
case CTR_AST_NODE_LTRNIL:
r = ctr_build_nil();
break;
case CTR_AST_NODE_LTRBOOLTRUE:
r = ctr_build_bool(1);
break;
case CTR_AST_NODE_LTRBOOLFALSE:
r = ctr_build_bool(0);
break;
case CTR_AST_NODE_LTRSTRING:
r = ctr_build_string(receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_LTRNUM:
r = ctr_build_number_from_string(receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_NESTED:
r = ctr_cwlk_expr(receiverNode, &wasReturn);
break;
case CTR_AST_NODE_CODEBLOCK:
r = ctr_build_block(receiverNode);
break;
default:
fprintf(stderr, CTR_ERR_SEND, receiverNode->type);
break;
}
int ctr_assume_message_level = ctr_in_message;
int ctr_is_chain = 0;
while(li->next) {
if (ctr_flag_sandbox && ++ctr_sandbox_steps>CTR_MAX_STEPS_LIMIT) exit(1);
if (ctr_is_chain) {
ctr_in_message++;
}
ctr_is_chain++;
ctr_argument* a;
ctr_argument* aItem;
ctr_size l;
li = li->next;
msgnode = li->node;
message = msgnode->value;
l = msgnode->vlen;
if (CtrStdFlow == NULL) {
ctr_callstack[ctr_callstack_index++] = msgnode;
}
argumentList = msgnode->nodes;
a = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
aItem = a;
aItem->object = CtrStdNil;
sticky = r->info.sticky;
r->info.sticky = 1;
if (literal) {
keys[key_index++] = ctr_gc_internal_pin(r);
}
if (argumentList) {
ctr_tnode* node;
node = argumentList->node;
while(1) {
ctr_in_message++;
ctr_object* o = ctr_cwlk_expr(node, &wasReturn);
ctr_in_message--;
aItem->object = o;
keys[key_index++] = ctr_gc_internal_pin(o);
if (key_index > 39) {
printf( CTR_ERR_KEYINX );
exit(1);
}
/* we always send at least one argument, note that if you want to modify the argumentList, be sure to take this into account */
/* there is always an extra empty argument at the end */
aItem->next = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
aItem = aItem->next;
aItem->object = CtrStdNil;
if (!argumentList->next) break;
argumentList = argumentList->next;
node = argumentList->node;
}
}
result = ctr_send_message(r, message, l, a);
r->info.sticky = sticky;
aItem = a;
if (CtrStdFlow == NULL) {
ctr_callstack_index --;
}
while(aItem->next) {
a = aItem;
aItem = aItem->next;
ctr_internal_object_delete_property(ctr_contexts[ctr_context_id], keys[--key_index], CTR_CATEGORY_PRIVATE_PROPERTY);
ctr_heap_free( a );
}
ctr_heap_free( aItem );
if (literal) {
ctr_internal_object_delete_property( ctr_contexts[ctr_context_id], keys[--key_index], CTR_CATEGORY_PRIVATE_PROPERTY );
}
r = result;
}
ctr_in_message -= (ctr_is_chain - 1);
if (ctr_in_message != ctr_assume_message_level) {
printf( CTR_ERR_ANOMALY );
exit(1);
}
if (recipientName) recipientName->info.sticky = 0;
return result;
}
