Commit 0bd8c17d authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

strings! no GC yet

parent 45f84d5f
......@@ -2,4 +2,10 @@ App1 !f a1 = f a1
App2 !f a1 a2 = f a1 a2
App3 !f a1 a2 a3 = f a1 a2 a3
App4 !f a1 a2 a3 a4 = f a1 a2 a3 a4
App5 !f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5
\ No newline at end of file
App5 !f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5
:: _Tuple2 = _Tuple2 a b
string_usize !str = _Tuple2 (string_size str) str
string_uselect !str !pos::I = _Tuple2 (string_select str pos) str
string_replace !str !idx::I !ch::C = _Tuple2 (string_select str idx) (string_update str idx ch)
......@@ -245,8 +245,30 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
}
case CT_APP_PRIM:
{
// TODO
abort("not implemented");
PrimEntry* desc = (PrimEntry*) ((AppEntry*) expr)->f;
int argmask = 1;
for (int i = 0; i < desc->base.arity; i++) {
if(desc->boxingMap & argmask)
{
placeholder();
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
else
{
push_a(NULL);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
argmask <<= 1;
}
desc->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
destroy_stack_frame_b(root_frame_ptr_b);
return;
}
case CT_APP_FUN1:
{
......@@ -309,6 +331,8 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
Desc* slice = ((AppEntry*) expr)->f;
Thunk* thunk = get_dst(root_frame_ptr);
// no need to check for array length, thunks in HNF are never overwritten
int newsize = slice->thunk_size;
if (thunk == NULL)
......@@ -403,6 +427,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case FT_RECORD:
{
Thunk* thunk = get_dst(root_frame_ptr);
// no need to check for array length, thunks in HNF are never overwritten
int newsize = slice->thunk_size;
if (thunk == NULL)
......@@ -446,6 +471,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
assert(is_hnf(arg));
// no need to check for array length, thunks in HNF are never overwritten
if(get_dst(root_frame_ptr) != NULL && arg->desc->thunk_size <= sizeof(Thunk))
{
memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
......@@ -560,7 +586,8 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
// NULL means "default", we accept it anyway
if(caseEntry->lit != NULL)
{
assert(caseEntry->lit->thunk.desc == (Desc*) __INT__);
assert(caseEntry->lit->thunk.desc == (Desc*) __INT__ ||
caseEntry->lit->thunk.desc == (Desc*) __BOOL__ );
if(caseEntry->lit->thunk._int != lit->_int) continue;
}
......
......@@ -388,7 +388,7 @@ Code* parseApp(char **ptr, bool dynamic, bool tr) {
if(desc != NULL) desc = get_slice(desc, nrArgsToParse);
entry->f = desc;
if(desc->type == FT_PRIM && ((PrimEntry*) desc)->boxingMap == 0b1)
if(desc->type == FT_PRIM && desc->arity == 1 && ((PrimEntry*) desc)->boxingMap == 0b1)
{
int arg0strict = entry->args[0]->type == CT_VAR_STRICT || entry->args[0]->type == CT_VAR_UNBOXED;
......@@ -407,7 +407,7 @@ Code* parseApp(char **ptr, bool dynamic, bool tr) {
entry->base.arg_pattern = 0;
}
}
else if(desc->type == FT_PRIM && ((PrimEntry*) desc)->boxingMap == 0b11)
else if(desc->type == FT_PRIM && desc->arity == 2 && ((PrimEntry*) desc)->boxingMap == 0b11)
{
int arg0strict = entry->args[0]->type == CT_VAR_STRICT || entry->args[0]->type == CT_VAR_UNBOXED;
int arg1strict = entry->args[1]->type == CT_VAR_STRICT || entry->args[1]->type == CT_VAR_UNBOXED;
......
......@@ -109,6 +109,241 @@ void __C2I(int dst_idx) {
target->_int = readC(arg(1));
}
void __string_size(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* arg = arg(1);
int length;
if(arg->desc == (Desc*) __STRING_PTR__)
{
length = arg->_string_ptr->length;
}
else
{
length = arg->_array.length;
}
target->desc = (Desc*) __INT__;
target->_int = length;
}
void __string_select(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* str = arg(2);
Thunk* pos = arg(1);
char* chars;
if(str->desc == (Desc*) __STRING_PTR__)
{
chars = str->_string_ptr->chars;
}
else
{
chars = str->_array._chars;
}
target->desc = (Desc*) __CHAR__;
target->_char = chars[pos->_int];
}
Thunk* string_create(Thunk* target, int len)
{
int newsize = sizeof (Desc) + sizeof (Array) + len;
if(target == NULL)
{
target = (Thunk*) alloc_heap(newsize);
}
else if(target->desc->thunk_size < newsize)
{
Thunk* tmp = (Thunk*) alloc_heap(newsize);
target->desc = (Desc*) __FORWARD_PTR__;
target->_forward_ptr = tmp;
target = tmp;
}
target->desc = (Desc*) __ARRAY__;
target->_array.is_string = true;
target->_array.is_boxed = true;
target->_array.bytes_per_elem = 1;
target->_array.length = len;
return target;
}
void __string_create1(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* len = arg(1);
set_return(dst_idx, string_create(target, len->_int));
}
void __string_create2(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* len = arg(2);
Thunk* ch = arg(1);
target = string_create(target, len->_int);
for(int i=0; i<len->_int; i++)
{
target->_array._chars[i] = ch->_char;
}
set_return(dst_idx, target);
}
void __string_update(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* str = arg(3);
Thunk* idx = arg(2);
Thunk* ch = arg(1);
int length;
char* chars;
if(str->desc == (Desc*) __STRING_PTR__)
{
chars = str->_string_ptr->chars;
length = str->_string_ptr->length;
}
else
{
chars = str->_array._chars;
length = str->_array.length;
}
target = string_create(target, length);
memcpy(target->_array._chars, chars, length);
target->_array._chars[idx->_int] = ch->_char;
set_return(dst_idx, target);
}
void __string_slice(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* str = arg(3);
Thunk* idx1 = arg(2);
Thunk* idx2 = arg(1);
char* chars;
if(str->desc == (Desc*) __STRING_PTR__)
{
chars = str->_string_ptr->chars;
}
else
{
chars = str->_array._chars;
}
int length = idx2->_int - idx1->_int + 1;
target = string_create(target, length);
memcpy(target->_array._chars, chars + idx1->_int, length);
set_return(dst_idx, target);
}
void __string_append(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* str1 = arg(2);
Thunk* str2 = arg(1);
int length1;
char* chars1;
if(str1->desc == (Desc*) __STRING_PTR__)
{
chars1 = str1->_string_ptr->chars;
length1 = str1->_string_ptr->length;
}
else
{
chars1 = str1->_array._chars;
length1 = str1->_array.length;
}
int length2;
char* chars2;
if(str2->desc == (Desc*) __STRING_PTR__)
{
chars2 = str2->_string_ptr->chars;
length2 = str2->_string_ptr->length;
}
else
{
chars2 = str2->_array._chars;
length2 = str2->_array.length;
}
target = string_create(target, length1 + length2);
memcpy(target->_array._chars, chars1, length1);
memcpy(target->_array._chars + length1, chars2, length2);
set_return(dst_idx, target);
}
void __eqS(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* str1 = arg(2);
Thunk* str2 = arg(1);
int length1;
char* chars1;
if(str1->desc == (Desc*) __STRING_PTR__)
{
chars1 = str1->_string_ptr->chars;
length1 = str1->_string_ptr->length;
}
else
{
chars1 = str1->_array._chars;
length1 = str1->_array.length;
}
int length2;
char* chars2;
if(str2->desc == (Desc*) __STRING_PTR__)
{
chars2 = str2->_string_ptr->chars;
length2 = str2->_string_ptr->length;
}
else
{
chars2 = str2->_array._chars;
length2 = str2->_array.length;
}
int eq = length1 == length2;
if(eq)
{
int i = 0;
while(i<length1 && eq)
{
eq = chars1[i] == chars2[i];
i++;
}
}
target->desc = (Desc*) __BOOL__;
target->_bool = eq;
}
void add_prim(int arity, int boxingMap, char* name, void (*exec)(int)) {
int nameLength = strlen(name);
......@@ -151,4 +386,13 @@ void init_prim() {
add_prim(2, 0b011, "or", &__or);
add_prim(2, 0b011, "mod", &__mod);
add_prim(1, 0b001, "C2I", &__C2I);
add_prim(1, 0b000, "string_size", &__string_size);
add_prim(2, 0b010, "string_select", &__string_select);
add_prim(1, 0b001, "string_create1", &__string_create1);
add_prim(2, 0b011, "string_create2", &__string_create2);
add_prim(3, 0b110, "string_update", &__string_update);
add_prim(3, 0b110, "string_slice", &__string_slice);
add_prim(2, 0b000, "string_append", &__string_append);
add_prim(2, 0b000, "eqS", &__eqS);
}
......@@ -81,6 +81,18 @@ void print(bool force) {
{
printf("%c", thunk->_string_ptr->chars[i]);
}
} else if ((FunEntry*) thunk->desc == __ARRAY__) {
if(thunk->_array.is_string)
{
for(int i=0; i< thunk->_array.length; i++)
{
printf("%c", thunk->_array._chars[i]);
}
}
else
{
printf("print: unhandled ARRAY type\n");
}
} else {
printf("print: unhandled BOXED LIT\n");
printDesc(thunk->desc);
......
main = PermSort.Start
PermSort.Start::I = PermSort.head (PermSort.permSort_12 (Flite.Cons 10 (Flite.Cons 9 (Flite.Cons 8 (Flite.Cons 7 (Flite.Cons 6 (Flite.Cons 5 (Flite.Cons 4 (Flite.Cons 3 (Flite.Cons 2 (Flite.Cons 1 Flite.Nil)))))))))))
:: Flite.List = Flite.Nil | Flite.Cons a1 a2
PermSort.permSort_12 !xs_0 = PermSort.head (PermSort.filter PermSort.ord_13 (PermSort.perm xs_0))
PermSort.perm !_x_0 = select _x_0 (Flite.Nil -> Flite.Cons Flite.Nil Flite.Nil) (Flite.Cons x_1_0 xs_1_1 -> PermSort.concatMap (PermSort.place x_1_0) (PermSort.perm xs_1_1))
PermSort.place x_0 !_x_1 = select _x_1 (Flite.Nil -> Flite.Cons (Flite.Cons x_0 Flite.Nil) Flite.Nil) (Flite.Cons y_1_0 ys_1_1 -> Flite.Cons (Flite.Cons x_0 (Flite.Cons y_1_0 ys_1_1)) (PermSort.map (Flite.Cons y_1_0) (PermSort.place x_0 ys_1_1)))
PermSort.map f_0 !_x_1 = select _x_1 (Flite.Nil -> Flite.Nil) (Flite.Cons x_1_0 xs_1_1 -> Flite.Cons (f_0 x_1_0) (PermSort.map f_0 xs_1_1))
PermSort.concatMap f_0 !_x_1 = select _x_1 (Flite.Nil -> Flite.Nil) (Flite.Cons x_1_0 xs_1_1 -> PermSort.append (f_0 x_1_0) (PermSort.concatMap f_0 xs_1_1))
PermSort.append !_x_0 ys_1 = select _x_0 (Flite.Nil -> ys_1) (Flite.Cons x_1_0 xs_1_1 -> Flite.Cons x_1_0 (PermSort.append xs_1_1 ys_1))
PermSort.ord_13::B !_x_0 = select _x_0 (Flite.Nil -> True) (Flite.Cons x_1_0 _x_1_1 -> select _x_1_1 (Flite.Nil -> True) (Flite.Cons y_2_0 ys_2_1 -> PermSort.and (<{PermSort.<=_14}> x_1_0 y_2_0) (PermSort.ord_13 (Flite.Cons y_2_0 ys_2_1))) )
<{PermSort.<=_14}>::B !x_0::I !y_1::I = not (ltI y_1 x_0)
PermSort.and::B !_x_0::B x_1::B = if _x_0 x_1 False
PermSort.filter p_0 !_x_1 = select _x_1 (Flite.Nil -> Flite.Nil) (Flite.Cons x_1_0 xs_1_1 -> if (p_0 x_1_0) (Flite.Cons x_1_0 (PermSort.filter p_0 xs_1_1)) (PermSort.filter p_0 xs_1_1))
PermSort.head !_x_0 = select _x_0 (Flite.Cons x_1_0 xs_1_1 -> x_1_0)
[40]
\ No newline at end of file
[Hello World!]
\ No newline at end of file
main = string.Start
string.Start = string_append "Hello " (string_append (<{StdString.%_10}> string.str (_Tuple2 6 10)) "!")
string.str = "Hello World!"
<{StdString.%_10}> !str_0 !_x_1 = select _x_1 (_Tuple2 a b -> string_slice str_0 a b)
[_Tuple2 [B] [A]]
\ No newline at end of file
main = string.Start
string.Start = _Tuple2 (<{string._if;14;10_2}> (eqS string.str "")) (<{string._if;14;34_3}> (eqS string.str (string_append "Hello" (string_append " " "World!"))))
string.str = "Hello World!"
<{string._if;14;34_3}> !_x_0::B = select _x_0 (True -> "A") (_ -> "B")
<{string._if;14;10_2}> !_x_0::B = select _x_0 (True -> "A") (_ -> "B")
[12]
\ No newline at end of file
main = string.Start
string.Start::I = string_size string.str
string.str = "Hello World!"
[o]
\ No newline at end of file
main = string.Start
string.Start::C = string_select string.str 4
string.str = "Hello World!"
[World]
\ No newline at end of file
main = string.Start
string.Start = <{StdString.%_10}> string.str (_Tuple2 6 10)
string.str = "Hello World!"
<{StdString.%_10}> !str_0 !_x_1 = select _x_1 (_Tuple2 a b -> string_slice str_0 a b)
[hello world!]
\ No newline at end of file
main = string.Start
string.Start = <{StdString.:=}> (<{StdString.:=}> string.str (_Tuple2 0 'h')) (_Tuple2 6 'w')
string.str = "Hello World!"
<{StdString.:=}> !s_0 !_x_1 = select _x_1 (_Tuple2 i_10 c_11 -> string_update s_0 i_10 c_11)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment