/**
* [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;
}
/**
* catch: [otherBlock]
*
* Associates an error clause to a block.
* If an error (exception) occurs within the block this block will be
* executed.
*
* Example:
*
* #Raise error on division by zero.
* {\
* var z := 4 / 0.
* } catch: { errorMessage |
* Pen write: e, brk.
* }, run.
*/
ctr_object* ctr_block_catch(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* catchBlock = argumentList->object;
ctr_internal_object_delete_property(myself, ctr_build_string("catch",5),0);
ctr_internal_object_add_property(myself, ctr_build_string("catch",5), catchBlock, 0);
return myself;
}
/**
* 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;
}
/**
* [Map] - [String]
*
* Deletes the entry, identified by the key specified in [String], from
* the map.
*
* In other languages:
* Dutch: [Lijst] - [Tekst] | Verwijderd de ingang voor aangegeven sleutel.
*/
ctr_object* ctr_map_delete(ctr_object* myself, ctr_argument* argumentList) {
ctr_internal_object_delete_property(myself, ctr_internal_cast2string(argumentList->object), 0);
return myself;
}
/**
* InternalObjectSetProperty
*
* Sets a property on an object.
*/
void ctr_internal_object_set_property(ctr_object* owner, ctr_object* key, ctr_object* value, int is_method) {
ctr_internal_object_delete_property(owner, key, is_method);
ctr_internal_object_add_property(owner, key, value, is_method);
}
