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