/** * [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); }