/** * [List] + [List] * * Returns a new list, containing elements of itself and the other * list. * * In other languages: * Dutch: [Reeks] + [Reeks] | Geeft de reeks die bestaat uit de samenvoeging van gegeven reeksen. */ ctr_object* ctr_array_add(ctr_object* myself, ctr_argument* argumentList) { ctr_object* otherArray = argumentList->object; ctr_object* newArray = ctr_array_new(CtrStdArray, NULL); int i; for(i = myself->value.avalue->tail; i<myself->value.avalue->head; i++) { ctr_argument* pushArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* elnumArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_object* elnum = ctr_build_number_from_float((ctr_number) i); elnumArg->object = elnum; pushArg->object = ctr_array_get(myself, elnumArg); ctr_array_push(newArray, pushArg); ctr_heap_free( elnumArg ); ctr_heap_free( pushArg ); } if (otherArray->info.type == CTR_OBJECT_TYPE_OTARRAY) { for(i = otherArray->value.avalue->tail; i<otherArray->value.avalue->head; i++) { ctr_argument* pushArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* elnumArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_object* elnum = ctr_build_number_from_float((ctr_number) i); elnumArg->object = elnum; pushArg->object = ctr_array_get(otherArray, elnumArg); ctr_array_push(newArray, pushArg); ctr_heap_free( elnumArg ); ctr_heap_free( pushArg ); } } return newArray; }
/** * [Map] each: [Block] * * Iterates over the map, passing key-value pairs to the specified block. * Note that within an each/map block, '⛏' and '⚿' refer to the collection. * * In other languages: * Dutch: [Lijst] elk: [Codeblok] | Past het blok code toe op elk paar uit de lijst. */ ctr_object* ctr_map_each(ctr_object* myself, ctr_argument* argumentList) { ctr_object* block = argumentList->object; ctr_mapitem* m; if (block->info.type != CTR_OBJECT_TYPE_OTBLOCK) { CtrStdFlow = ctr_build_string_from_cstring( CTR_ERR_EXP_BLK ); CtrStdFlow->info.sticky = 1; } block->info.sticky = 1; m = myself->properties->head; while(m && !CtrStdFlow) { ctr_argument* arguments = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* argument2 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* argument3 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); arguments->object = m->key; argument2->object = m->value; argument3->object = myself; arguments->next = argument2; argument2->next = argument3; ctr_block_run(block, arguments, myself); if (CtrStdFlow == CtrStdContinue) CtrStdFlow = NULL; m = m->next; ctr_heap_free( arguments ); ctr_heap_free( argument2 ); ctr_heap_free( argument3 ); } if (CtrStdFlow == CtrStdBreak) CtrStdFlow = NULL; block->info.mark = 0; block->info.sticky = 0; return myself; }
/** * [List] map: [Block]. * * Iterates over the array. Passing each element as a key-value pair to the * specified block. * The map message will pass the following arguments to the block, the key, * the value and a reference to the array itself. The last argument might seem * redundant but allows for a more functional programming style. Instead of map, * you can also use each:. * * Usage: * * files map: showName. * files map: { * :key :filename :files * ✎ write: filename. * }. * * files each: { * :key :filename :files * ✎ write: filename. * }. * * In other languages: * Dutch: [Reeks] lijst: [Codeblok] | Maakt van een reeks */ ctr_object* ctr_array_map(ctr_object* myself, ctr_argument* argumentList) { ctr_object* block = argumentList->object; int i = 0; if (block->info.type != CTR_OBJECT_TYPE_OTBLOCK) { CtrStdFlow = ctr_build_string_from_cstring( CTR_ERR_EXP_BLK ); CtrStdFlow->info.sticky = 1; } for(i = myself->value.avalue->tail; i < myself->value.avalue->head; i++) { ctr_argument* arguments = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* argument2 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* argument3 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); arguments->object = ctr_build_number_from_float((double) i); argument2->object = *(myself->value.avalue->elements + i); argument3->object = myself; arguments->next = argument2; argument2->next = argument3; /* keep receiver in block object otherwise, GC will destroy it */ ctr_gc_internal_pin(block); ctr_gc_internal_pin(myself); ctr_gc_internal_pin(argument2->object); ctr_block_run(block, arguments, myself); ctr_heap_free( arguments ); ctr_heap_free( argument2 ); ctr_heap_free( argument3 ); if (CtrStdFlow == CtrStdContinue) CtrStdFlow = NULL; if (CtrStdFlow) break; } if (CtrStdFlow == CtrStdBreak) CtrStdFlow = NULL; /* consume break */ return myself; }
/** * [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; }
/** * [File] read * * Reads contents of a file. Send this message to a file to read the entire contents in * one go. For big files you might want to prefer a streaming approach to avoid * memory exhaustion (see readBytes etc). * * Usage: * * data := File new: '/path/to/mydata.csv', read. * * In the example above we read the contents of the entire CSV file callled mydata.csv * in the variable called data. */ ctr_object* ctr_file_read(ctr_object* myself, ctr_argument* argumentList) { ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0); ctr_object* str; ctr_size vlen, fileLen; char* pathString; char *buffer; FILE* f; if (path == NULL) return CtrStdNil; vlen = path->value.svalue->vlen; pathString = ctr_heap_allocate( sizeof(char) * ( vlen + 1 ) ); memcpy(pathString, path->value.svalue->value, vlen); memcpy(pathString+vlen,"\0",1); f = fopen(pathString, "rb"); ctr_heap_free( pathString ); if (!f) { CtrStdFlow = ctr_build_string_from_cstring( "Unable to open file." ); CtrStdFlow->info.sticky = 1; return CtrStdNil; } fseek(f, 0, SEEK_END); fileLen=ftell(f); fseek(f, 0, SEEK_SET); buffer=(char *)ctr_heap_allocate(fileLen+1); if (!buffer){ printf("Out of memory\n"); fclose(f);exit(1); } fread(buffer, fileLen, 1, f); fclose(f); str = ctr_build_string(buffer, fileLen); ctr_heap_free( buffer ); return str; }
ctr_object* ctr_json_create_object(json_t* root, ctr_object* gt) { switch(json_typeof(root)) { case JSON_OBJECT: { ctr_object* sub = ctr_internal_create_object(CTR_OBJECT_TYPE_OTOBJECT); ctr_set_link_all(sub, gt); // size_t size; const char *key; json_t *value; ctr_argument* argl = ctr_heap_allocate(sizeof(*argl)); argl->next = ctr_heap_allocate(sizeof(*argl)); // size = json_object_size(root); json_object_foreach(root, key, value) { char* k = (char*)key; ctr_object* ko = ctr_build_string_from_cstring(k); ctr_object* vo = ctr_json_create_object(value, gt); argl->object = vo; argl->next->object = ko; sub = ctr_map_put(sub, argl); } ctr_heap_free(argl->next); ctr_heap_free(argl); return sub; } case JSON_ARRAY: { ctr_object* arr = ctr_array_new(CtrStdArray, NULL); ctr_argument* arg = ctr_heap_allocate(sizeof(ctr_argument)); size_t i; size_t size = json_array_size(root); for (i = 0; i < size; i++) { arg->object = ctr_json_create_object(json_array_get(root, i), gt); ctr_array_push(arr, arg); } ctr_heap_free(arg); return arr; } case JSON_STRING: { ctr_object* str = ctr_build_string((char*)json_string_value(root), json_string_length(root)); return str; } case JSON_INTEGER: { return ctr_build_number_from_float(json_integer_value(root)); } case JSON_REAL: { return ctr_build_number_from_float(json_real_value(root)); } case JSON_FALSE: { return ctr_build_bool(0); } case JSON_TRUE: { return ctr_build_bool(1); } case JSON_NULL: { return ctr_build_nil(); } default: { CtrStdFlow = ctr_build_string_from_cstring("Unrecognized JSON type"); return CtrStdNil; } }
/** * Loads a dictionary into memory. * A dictionary file has the following format: * * <t> "<word>" "<translation>" * * Where <t> is 't' for token (i.e. a programming language word) * or 's' for string (a literal series of bytes declared in the Citrine program). * This allows the dictionary to specify both translations for * objects, variables and messages as well as for user interface strings * and text snippets. There is no need to translate comments because * Citrine does not support them. This is always the reason why. */ ctr_dict* ctr_translate_load_dictionary() { FILE* file = fopen(ctr_mode_dict_file,"r"); if (file == NULL) { ctr_print_error(CTR_TERR_DICT, 1); } char translationType; char* word = calloc(CTR_TRANSLATE_MAX_WORD_LEN, 1); char* translation = calloc(CTR_TRANSLATE_MAX_WORD_LEN, 1); char* buffer; char* format; ctr_dict* entry; ctr_dict* previousEntry = NULL; ctr_dict* e; while( fscanf( file, "%c \"%80[^\"]\" \"%80[^\"]\"\n", &translationType, word, translation) > 0 ) { entry = (ctr_dict*) calloc( sizeof(ctr_dict), 1 ); entry->type = translationType; entry->wordLength = strlen(word); entry->translationLength = strlen(translation); if (entry->wordLength > CTR_TRANSLATE_MAX_WORD_LEN || entry->translationLength > CTR_TRANSLATE_MAX_WORD_LEN) { ctr_print_error(CTR_TERR_ELONG, 1); } entry->word = calloc( entry->wordLength, 1 ); entry->translation = calloc( entry->translationLength, 1 ); memcpy(entry->word, word, entry->wordLength); memcpy(entry->translation, translation, entry->translationLength); if (previousEntry) { entry->next = previousEntry; } else { entry->next = NULL; } previousEntry = entry; e = entry; while(e->next != NULL) { e = e->next; if (e->type == entry->type) { if ( e->wordLength == entry->wordLength ) { if ( strncmp( e->word, entry->word, entry->wordLength ) == 0 ) { format = CTR_TERR_AMWORD; buffer = ctr_heap_allocate( 600 * sizeof(char) ); snprintf( buffer, 600 * sizeof(char), format, word ); ctr_print_error( buffer, 1 ); } } if ( e->translationLength == entry->translationLength ) { if ( strncmp( e->translation, entry->translation, entry->translationLength ) == 0 ) { format = CTR_TERR_AMTRANS; buffer = ctr_heap_allocate(600 * sizeof(char)); snprintf( buffer, 600 * sizeof(char), format, translation); ctr_print_error( buffer, 1 ); } } } } } fclose(file); return entry; }
/** * [List] new * * Creates a new array. * An array is a collection of items. To create a new array, * send the 'new' message to the array. To add an element send * the 'push:' message to an array with the element to add as * an argument. Instead of using the push-message you can also * use the • message. This message is suitable for vertically * written arrays because they look similar to lists seen in * regular documents. Besides 'push:' and • you can also use * the ; message to push an new element on top of the array. * The arrow message is the same as 'new' plus 'push:', just a * shorter notation. The ; message is very suitable for * horizontally written arrays. Finally, the last example * depicts a notation using just ascii characters. * * Usage: * * ☞ meals := * List new * • 'hamburger' * • 'pizza' * • 'haggis'. * * ☞ todo := List ← 'dishes' ; 'cleaning'. * * In other languages: * Dutch: Reeks nieuw. Maakt een nieuwe reeks. * Gebruik ← om een lijst te maken en direct te vullen. * Voorbeeld: ☞ oneven := Reeks ← 1 ; 3 ; 5. * */ ctr_object* ctr_array_new(ctr_object* myclass, ctr_argument* argumentList) { ctr_object* s = ctr_internal_create_object(CTR_OBJECT_TYPE_OTARRAY); s->link = myclass; s->value.avalue = (ctr_collection*) ctr_heap_allocate(sizeof(ctr_collection)); s->value.avalue->length = 1; s->value.avalue->elements = (ctr_object**) ctr_heap_allocate(sizeof(ctr_object*)*1); s->value.avalue->head = 0; s->value.avalue->tail = 0; return s; }
/** * [List] copy * * Copies the list. The list object will answer this message by * returning a shallow copy of itself. This means that the values in the * newly returned list can be replaced or deleted without affecting * the original one. However, modifying the values in the list will * still cause their counterparts in the original list to be modified * as well. * In the example we replace the first item (1) in b with 999. * The first element in a will still be 1 though because we have created * copy b by sending the message 'copy' to a and assiging the result * to b. * * Usage: * * ☞ a := List ← 1 ; 2 ; 3. * ☞ b := a copy. * b put: 999 at: 1. * * In other languages: * Dutch: [Reeks] kopieer | Maakt een kopie van de reeks. */ ctr_object* ctr_array_copy(ctr_object* myself, ctr_argument* argumentList) { ctr_size i = 0; ctr_object* copy = ctr_array_new( CtrStdArray, argumentList ); ctr_argument* arg = 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); arg->object = ctr_array_get( myself, index ); ctr_array_push( copy, arg ); } ctr_heap_free( arg ); ctr_heap_free( index ); return copy; }
/** * [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; }
/** * [List] join: [String]. * * Joins the elements of a list together in a string * separated by a specified glue string. The example * code results in the string: '1,2,3'. * * Usage: * * collection := List new. * collection append: 1, append: 2, append 3. * collection join: ','. * * In other languages: * Dutch: [Reeks] samenvoegen: [Tekst] | Maakt een tekst door * reekselementen samen te voegen met gespecificeerde koppelteken(s). */ ctr_object* ctr_array_join(ctr_object* myself, ctr_argument* argumentList) { int i; char* result; ctr_size len = 0; ctr_size pos; ctr_object* o; ctr_object* str; ctr_object* resultStr; ctr_object* glue = ctr_internal_cast2string(argumentList->object); ctr_size glen = glue->value.svalue->vlen; for(i=myself->value.avalue->tail; i<myself->value.avalue->head; i++) { o = *( myself->value.avalue->elements + i ); str = ctr_internal_cast2string(o); pos = len; if (i == myself->value.avalue->tail) { len = str->value.svalue->vlen; result = ctr_heap_allocate(sizeof(char)*len); } else { len += str->value.svalue->vlen + glen; result = ctr_heap_reallocate(result, sizeof(char)*len ); memcpy(result+pos, glue->value.svalue->value, glen); pos += glen; } memcpy(result+pos, str->value.svalue->value, str->value.svalue->vlen); } resultStr = ctr_build_string(result, len); if (i > myself->value.avalue->tail) ctr_heap_free( result ); return resultStr; }
/** * @internal * * Returns an array from the request, either for GET, POST or COOKIE. */ ctr_object* ctr_request_array(ctr_object* myself, ctr_argument* argumentList, CGI_varlist* varlist) { ctr_object* cgiVarObject; ctr_object* list; char* cgiVar; const CGI_value* value; char* val; ctr_argument* arg; int i = 0; list = ctr_array_new(CtrStdArray, NULL); cgiVarObject = ctr_internal_cast2string(argumentList->object); cgiVar = ctr_heap_allocate_cstring( cgiVarObject ); value = CGI_lookup_all(varlist, (const char*)cgiVar); ctr_heap_free( cgiVar ); if (value == NULL) { return list; } for (i = 0; value[i] != 0; i++) { arg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); val = (char*) value[i]; arg->object = ctr_build_string_from_cstring(val); ctr_array_push(list, arg); ctr_heap_free( arg ); } return list; }
/** * [Map] string * * Returns a string representation of a map encoded in Citrine itself. * This will give you an * evallable representation of the map and all of its members. * The sting method is automatically invoked when attempting to * print a Map: * * Usage * * m := (Map new) put: 'hello' at: 'world'. * x := m string. * ✎ write: (Map new). * * In other languages: * Dutch: [Lijst] tekst | Geeft tekstuele weergave van lijst (kan weer worden geevalueerd) */ ctr_object* ctr_map_to_string( ctr_object* myself, ctr_argument* argumentList) { ctr_object* string; ctr_mapitem* mapItem; ctr_argument* newArgumentList; string = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_MAP_NEW ); mapItem = myself->properties->head; newArgumentList = ctr_heap_allocate( sizeof( ctr_argument ) ); while( mapItem ) { newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_MAP_PUT ); ctr_string_append( string, newArgumentList ); if ( mapItem->value->info.type == CTR_OBJECT_TYPE_OTBOOL || mapItem->value->info.type == CTR_OBJECT_TYPE_OTNUMBER || mapItem->value->info.type == CTR_OBJECT_TYPE_OTNIL ) { newArgumentList->object = mapItem->value; ctr_string_append( string, newArgumentList ); } else if ( mapItem->value->info.type == CTR_OBJECT_TYPE_OTSTRING ) { newArgumentList->object = ctr_build_string_from_cstring( "'" ); ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_string_quotes_escape( mapItem->value, newArgumentList ); ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_build_string_from_cstring( "'" ); ctr_string_append( string, newArgumentList ); } else { newArgumentList->object = ctr_build_string_from_cstring( "(" ); ctr_string_append( string, newArgumentList ); newArgumentList->object = mapItem->value; ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_build_string_from_cstring( ")" ); ctr_string_append( string, newArgumentList ); } newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_MAP_PUT_AT ); ctr_string_append( string, newArgumentList ); if ( mapItem->key->info.type == CTR_OBJECT_TYPE_OTBOOL || mapItem->key->info.type == CTR_OBJECT_TYPE_OTNUMBER || mapItem->value->info.type == CTR_OBJECT_TYPE_OTNIL ) { newArgumentList->object = mapItem->key; ctr_string_append( string, newArgumentList ); } else if ( mapItem->key->info.type == CTR_OBJECT_TYPE_OTSTRING ) { newArgumentList->object = ctr_build_string_from_cstring( "'" ); ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_string_quotes_escape( mapItem->key, newArgumentList ); ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_build_string_from_cstring( "'" ); ctr_string_append( string, newArgumentList ); } else { newArgumentList->object = ctr_build_string_from_cstring( "(" ); ctr_string_append( string, newArgumentList ); newArgumentList->object = mapItem->key; ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_build_string_from_cstring( ")" ); ctr_string_append( string, newArgumentList ); } mapItem = mapItem->next; if ( mapItem ) { newArgumentList->object = ctr_build_string_from_cstring( ", " ); ctr_string_append( string, newArgumentList ); } } ctr_heap_free( newArgumentList ); return string; }
/** * Given a pair of Citrine dictionary source headers this functions * generates a token translation dictionary. */ void ctr_translate_generate_dicts(char* hfile1, char* hfile2) { FILE* f1 = fopen(hfile1, "r"); FILE* f2 = fopen(hfile2, "r"); if (f1 == NULL || f2 == NULL) { ctr_print_error(CTR_TERR_DICT, 1); } char* word = calloc(CTR_TRANSLATE_MAX_WORD_LEN, 1); char* translation = calloc(CTR_TRANSLATE_MAX_WORD_LEN, 1); char* key1 = calloc(CTR_TRANSLATE_MAX_WORD_LEN, 1); char* key2 = calloc(CTR_TRANSLATE_MAX_WORD_LEN, 1); char* format; char* buffer; int lineCounter = 0; while( fscanf( f1, "#define %180s \"%180[^\"]\"\n", key1, word ) > 0 && fscanf( f2, "#define %180s \"%180[^\"]\"\n", key2, translation) > 0 ) { if (strlen(key1)!=strlen(key2) || strncmp(key1, key2, strlen(key1))!=0) { format = CTR_TERR_KMISMAT; buffer = ctr_heap_allocate(600); snprintf(buffer, 600, format, key1, key2, lineCounter); ctr_print_error(buffer, 1); } printf("t \"%s\" \"%s\"\n", word, translation); lineCounter++; } fclose(f1); fclose(f2); }
int ctr_sort_cmp(const void * a, const void * b) { ctr_argument* arg1 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_argument* arg2 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); ctr_object* result; ctr_object* numResult; arg1->next = arg2; arg1->object = *((ctr_object**) a); arg2->object = *((ctr_object**) b); ctr_gc_internal_pin(temp_sorter); ctr_gc_internal_pin(temp_self); ctr_gc_internal_pin(arg1->object); ctr_gc_internal_pin(temp_self); result = ctr_block_run(temp_sorter, arg1, temp_self); numResult = ctr_internal_cast2number(result); ctr_heap_free( arg1 ); ctr_heap_free( arg2 ); return (int) numResult->value.nvalue; }
/** * @internal * * callback for SCGI server. */ void ctr_request_serve_callback() { ctr_argument* argumentList; argumentList = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); varlistGet = CGI_get_query(NULL); varlistCookie = CGI_get_cookie(NULL); varlistPost = CGI_get_post(NULL,"/tmp/_upXXXXXX"); ctr_block_run(CtrStdSCGICB, argumentList, CtrStdSCGICB); ctr_heap_free( argumentList ); CGI_free_varlist(varlistGet); CGI_free_varlist(varlistPost); CGI_free_varlist(varlistCookie); }
/** * [List] replace: [Number] length: [Number] with: [List]. * * Returns a copy of the list with the specified elements replaced. * The first argument indicates the start index to begin the replacement. * Here, 0 means the beginning of the list. * The second argument (length) * must indicate the number of elements to delete in the copy, counting * from the starting point. Finally, one has to provide the replacement * list as the third argument. * If the replacement list is empty, the specified elements will only be * removed from the copy. * If the replacement is not an array an error will be thrown. * * Usage: * * ☞ buy := cakes * replace: 1 * length: 2 * with: ( List ← 'cinnamon' ; 'pineapple' ). * * In other languages: * Dutch: [Reeks] vervang: [Getal] lengte: [Getal] door: [Reeks] * Vervangt een deel van de reeks door een andere reeks. */ ctr_object* ctr_array_splice(ctr_object* myself, ctr_argument* argumentList) { ctr_object* newArray = ctr_array_new(CtrStdArray, NULL); ctr_object* start = ctr_internal_cast2number(argumentList->object); ctr_object* deleteCount = ctr_internal_cast2number(argumentList->next->object); ctr_object* replacement = argumentList->next->next->object; ctr_object* remainder; ctr_argument* sliceFromArg; ctr_argument* sliceLengthArg; ctr_argument* replacementArg; ctr_argument* remainderArg; ctr_size n; if ( replacement->info.type != CTR_OBJECT_TYPE_OTARRAY ) { CtrStdFlow = ctr_error_text( CTR_ERR_EXP_ARR ); return myself; } n = ( start->value.nvalue + deleteCount->value.nvalue ); sliceFromArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); sliceLengthArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); replacementArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); remainderArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); sliceFromArg->object = ctr_build_number_from_float(0); sliceLengthArg->object = start; sliceFromArg->next = sliceLengthArg; newArray = ctr_array_from_length( myself, sliceFromArg ); replacementArg->object = replacement; newArray = ctr_array_add(newArray, replacementArg); sliceFromArg->object = ctr_build_number_from_float( n ); if ( n < (myself->value.avalue->head - myself->value.avalue->tail) ) { sliceLengthArg->object = ctr_build_number_from_float( (myself->value.avalue->head - myself->value.avalue->tail) - n ); sliceFromArg->next = sliceLengthArg; remainder = ctr_array_from_length( myself, sliceFromArg ); remainderArg->object = remainder; newArray = ctr_array_add( newArray, remainderArg ); } ctr_heap_free( sliceFromArg ); ctr_heap_free( sliceLengthArg ); ctr_heap_free( replacementArg ); ctr_heap_free( remainderArg ); return newArray; }
/** * [List] fill: [Number] with: [Object] * * Fills the list with the specified number of objects. * * Usage: * * ☞ a := List new fill: 42 with: 'x'. * * In other languages: * Dutch: [Reeks] vul: [Getal] met: [Object] * Vult de reeks op met een gespecificeerd aantal elementen. */ ctr_object* ctr_array_fill( ctr_object* myself, ctr_argument* argumentList ) { size_t n; int i; ctr_argument* newArgumentList; n = ctr_internal_cast2number( argumentList->object )->value.nvalue; newArgumentList = ctr_heap_allocate( sizeof(ctr_argument) ); newArgumentList->object = argumentList->next->object; for(i = 0; i < n; i ++ ) { ctr_array_push( myself, newArgumentList ); } ctr_heap_free(newArgumentList); return myself; }
/** * [List] from: [Begin] length: [End] * * Copies part of an array indicated by from and to and * returns a new array consisting of a copy of this region. * * In other languages: * Dutch: [Reeks] van: [Getal] lengte: [Getal] | Geeft subreeks. */ ctr_object* ctr_array_from_length(ctr_object* myself, ctr_argument* argumentList) { ctr_argument* pushArg; ctr_argument* elnumArg; ctr_object* elnum; ctr_object* startElement = ctr_internal_cast2number(argumentList->object); ctr_object* count = ctr_internal_cast2number(argumentList->next->object); int start = (int) startElement->value.nvalue; int len = (int) count->value.nvalue; int i = 0; ctr_object* newArray = ctr_array_new(CtrStdArray, NULL); for(i = start; i < start + len; i++) { pushArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); elnumArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); elnum = ctr_build_number_from_float((ctr_number) i); elnumArg->object = elnum; pushArg->object = ctr_array_get(myself, elnumArg); ctr_array_push(newArray, pushArg); ctr_heap_free( elnumArg ); ctr_heap_free( pushArg ); } return newArray; }
/** * [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; }
/** * Curl new. * * Creates new Curl handle via curl_easy_init * **/ ctr_object* ctr_curl_new(ctr_object* myself, ctr_argument* argumentList) { ctr_object* curlObjectInstance = ctr_internal_create_object(CTR_OBJECT_TYPE_OTOBJECT); curlObjectInstance->link = myself; curlObjectInstance->info.type = CTR_OBJECT_TYPE_OTEX; ctr_resource* rsrc = ctr_heap_allocate(sizeof(ctr_resource)); rsrc->type = CTR_OBJECT_RESOURCE_CURL; rsrc->ptr = curl_easy_init(); curlObjectInstance->value.rvalue = rsrc; return curlObjectInstance; }
/** * [Map] values * * Returns an array containing all the keys in the map. * The order of the keys is undefined. Use the sort message * to enforce a specific order. * * Usage: * * ☞ city := List ← 'London' ; 'Paris' ; 'Berlin'. * ☞ temperature := List ← '15' ; '16' ; '15'. * * ☞ weather := temperature by: city. * temperatures := weather values sort: { * :a :b ↲ (a compare: b). * }. * * In other languages: * Dutch: [Lijst] waarden | Geeft alle waarden uit de lijst als een reeks. */ ctr_object* ctr_map_values(ctr_object* myself, ctr_argument* argumentList) { ctr_object* list; ctr_mapitem* m; ctr_argument* element; list = ctr_array_new( CtrStdArray, argumentList ); m = myself->properties->head; element = ctr_heap_allocate( sizeof( ctr_argument ) ); while( m ) { element->object = m->value; ctr_array_push( list, element ); m = m->next; } ctr_heap_free( element ); return list; }
/** * [File] exists * * Returns True if the file exists and False otherwise. */ ctr_object* ctr_file_exists(ctr_object* myself, ctr_argument* argumentList) { ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0); ctr_size vlen; char* pathString; FILE* f; int exists; if (path == NULL) return ctr_build_bool(0); vlen = path->value.svalue->vlen; pathString = ctr_heap_allocate(vlen + 1); memcpy(pathString, path->value.svalue->value, vlen); memcpy(pathString+vlen,"\0",1); f = fopen(pathString, "r"); ctr_heap_free( pathString ); exists = (f != NULL ); if (f) { fclose(f); } return ctr_build_bool(exists); }
/** * [File] delete * * Deletes the file. */ ctr_object* ctr_file_delete(ctr_object* myself, ctr_argument* argumentList) { ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0); ctr_size vlen; char* pathString; int r; if (path == NULL) return myself; vlen = path->value.svalue->vlen; pathString = ctr_heap_allocate( sizeof( char ) * ( vlen + 1 ) ); memcpy(pathString, path->value.svalue->value, vlen); memcpy(pathString+vlen,"\0",1); r = remove(pathString); ctr_heap_free( pathString ); if (r!=0) { CtrStdFlow = ctr_build_string_from_cstring( "Unable to delete file." ); CtrStdFlow->info.sticky = 1; return CtrStdNil; } return myself; }
/** * [File] readBytes: [Number]. * * Reads a number of bytes from the file. * * Usage: * * f := File new: '/path/to/file.txt'. * f open: 'r+'. * x := f readBytes: 10. * f close. * * The example above reads 10 bytes from the file represented by f * and puts them in buffer x. */ ctr_object* ctr_file_read_bytes(ctr_object* myself, ctr_argument* argumentList) { int bytes; char* buffer; ctr_object* result; if (myself->value.rvalue == NULL) return myself; if (myself->value.rvalue->type != 1) return myself; bytes = ctr_internal_cast2number(argumentList->object)->value.nvalue; if (bytes < 0) return ctr_build_string_from_cstring(""); buffer = (char*) ctr_heap_allocate(bytes); if (buffer == NULL) { CtrStdFlow = ctr_build_string_from_cstring("Cannot allocate memory for file buffer."); CtrStdFlow->info.sticky = 1; return ctr_build_string_from_cstring(""); } fread(buffer, sizeof(char), (int)bytes, (FILE*)myself->value.rvalue->ptr); result = ctr_build_string(buffer, bytes); ctr_heap_free( buffer ); return result; }
/** * [List] string * * Returns a string representation of the list and its contents. * This representation will be encoded in the Citrine language itself and can * therefore be evaluated again. * In the example: 'string' messages are implicitly * send by some objects, for instance when * attempting to write a List using a Pen. * * Usage: * * ☞ a := List ← 'hello' ; 'world'. * ☞ b := a string. * ☞ c := b evaluate. * * In other languages: * Dutch: [Reeks] tekst * Geeft een tekstuele versie van de reeks terug. Deze tekst kan opnieuw worden * ingelezen door Citrine om er een reeks van te maken (evalueer). */ ctr_object* ctr_array_to_string( ctr_object* myself, ctr_argument* argumentList ) { int i; ctr_object* arrayElement; ctr_argument* newArgumentList; ctr_object* string = ctr_build_empty_string(); newArgumentList = ctr_heap_allocate( sizeof( ctr_argument ) ); if ( myself->value.avalue->tail == myself->value.avalue->head ) { newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_ARRAY_NEW ); string = ctr_string_append( string, newArgumentList ); } else { newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_ARRAY_NEW_PUSH ); string = ctr_string_append( string, newArgumentList ); } for(i=myself->value.avalue->tail; i<myself->value.avalue->head; i++) { arrayElement = *( myself->value.avalue->elements + i ); if ( arrayElement->info.type == CTR_OBJECT_TYPE_OTBOOL || arrayElement->info.type == CTR_OBJECT_TYPE_OTNUMBER || arrayElement->info.type == CTR_OBJECT_TYPE_OTNIL ) { newArgumentList->object = arrayElement; string = ctr_string_append( string, newArgumentList ); } else if ( arrayElement->info.type == CTR_OBJECT_TYPE_OTSTRING ) { newArgumentList->object = ctr_build_string_from_cstring("'"); string = ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_string_quotes_escape( arrayElement, newArgumentList ); string = ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_build_string_from_cstring("'"); string = ctr_string_append( string, newArgumentList ); } else { newArgumentList->object = ctr_build_string_from_cstring("("); ctr_string_append( string, newArgumentList ); newArgumentList->object = arrayElement; string = ctr_string_append( string, newArgumentList ); newArgumentList->object = ctr_build_string_from_cstring(")"); ctr_string_append( string, newArgumentList ); } if ( (i + 1 )<myself->value.avalue->head ) { newArgumentList->object = ctr_build_string_from_cstring(" ; "); string = ctr_string_append( string, newArgumentList ); } } ctr_heap_free( newArgumentList ); return string; }
/** * [Curl] perform. * * Performs a blocking file transfer * **/ ctr_object* ctr_curl_perform(ctr_object* myself, ctr_argument* argumentList) { FILE *temp = tmpfile(); curl_easy_setopt(myself->value.rvalue->ptr, CURLOPT_WRITEDATA, temp); CURLcode code = curl_easy_perform(myself->value.rvalue->ptr); if (code != CURLE_OK) CtrStdFlow = ctr_error_text("Received Curl error code"); fseek(temp, 0, SEEK_END); ctr_size fileLen = ftell(temp); fseek(temp, 0, SEEK_SET); char *buffer = (char *)ctr_heap_allocate(fileLen + 1); if (!buffer) { printf("Out of memory\n"); fclose(temp); exit(1); } fread(buffer, fileLen, 1, temp); fclose(temp); ctr_object *str = ctr_build_string(buffer, fileLen); ctr_heap_free(buffer); return str; }
/** * [File] append: [String] * * Appends content to a file. The file object responds to this message like it * responds to the write-message, however in this case the contents of the string * will be appended to the existing content inside the file. */ ctr_object* ctr_file_append(ctr_object* myself, ctr_argument* argumentList) { ctr_object* str = ctr_internal_cast2string(argumentList->object); ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0); ctr_size vlen; char* pathString; FILE* f; if (path == NULL) return myself; vlen = path->value.svalue->vlen; pathString = ctr_heap_allocate(vlen + 1); memcpy(pathString, path->value.svalue->value, vlen); memcpy(pathString+vlen,"\0",1); f = fopen(pathString, "ab+"); ctr_heap_free( pathString ); if (!f) { CtrStdFlow = ctr_build_string_from_cstring("Unable to open file.\0"); CtrStdFlow->info.sticky = 1; return CtrStdNil; } fwrite(str->value.svalue->value, sizeof(char), str->value.svalue->vlen, f); fclose(f); return myself; }
/** * [List] put: [Object] at: [Number] * * Puts an object (which can be anything) in the list * at the specified position. * The list will be automatically expanded if the position number * is higher than the maximum of the list. * * Usage: * * ☞ fruits := List new. * ☞ fruits put: 'apples' at: 5. * * In other languages: * Dutch: [Reeks] zet: [Object] bij: [Getal] * Plaatst het object op de aangegeven positie in de reeks. */ ctr_object* ctr_array_put(ctr_object* myself, ctr_argument* argumentList) { ctr_object* putValue = argumentList->object; ctr_object* putIndex = ctr_internal_cast2number(argumentList->next->object); ctr_size putIndexNumber; ctr_size head; ctr_size tail; if (putIndex->value.nvalue < 0) { CtrStdFlow = ctr_build_string_from_cstring( CTR_ERR_BOUNDS ); CtrStdFlow->info.sticky = 1; return myself; } head = (ctr_size) myself->value.avalue->head; tail = (ctr_size) myself->value.avalue->tail; putIndexNumber = (ctr_size) putIndex->value.nvalue; if (head <= putIndexNumber) { ctr_size j; for(j = head; j <= putIndexNumber; j++) { ctr_argument* argument; argument = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) ); argument->object = CtrStdNil; ctr_array_push(myself, argument); ctr_heap_free( argument ); } myself->value.avalue->head = putIndexNumber + 1; } if (putIndexNumber < tail) { ctr_size j; for(j = tail; j > putIndexNumber; j--) { *(myself->value.avalue->elements + j) = CtrStdNil; } myself->value.avalue->tail = putIndexNumber; } *(myself->value.avalue->elements + putIndexNumber) = putValue; return myself; }
/** * [File] size * * Returns the size of the file. */ ctr_object* ctr_file_size(ctr_object* myself, ctr_argument* argumentList) { ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0); ctr_size vlen; char* pathString; FILE* f; int prev, sz; if (path == NULL) return ctr_build_number_from_float(0); vlen = path->value.svalue->vlen; pathString = ctr_heap_allocate( sizeof(char) * ( vlen + 1 ) ); memcpy(pathString, path->value.svalue->value, ( sizeof( char ) * vlen ) ); memcpy(pathString+vlen,"\0",1); f = fopen(pathString, "r"); ctr_heap_free( pathString ); if (f == NULL) return ctr_build_number_from_float(0); prev = ftell(f); fseek(f, 0L, SEEK_END); sz=ftell(f); fseek(f,prev,SEEK_SET); if (f) { fclose(f); } return ctr_build_number_from_float( (ctr_number) sz ); }