strings! no GC yet

interpreter/builtin.sapl

@@ -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)

interpreter/code.c

@@ -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;
                 }

interpreter/parse.c

@@ -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;

interpreter/prim.c

@@ -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);
 }

interpreter/thunk.c

@@ -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);

tests/PermSort.sapl

+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) 

tests/While.exp

+[40]
\ No newline at end of file

tests/string_append.exp

+[Hello World!]
\ No newline at end of file

tests/string_append.sapl

+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)

tests/string_eq.exp

+[_Tuple2 [B] [A]]
\ No newline at end of file

tests/string_eq.sapl

+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")

tests/string_length.exp

+[12]
\ No newline at end of file

tests/string_length.sapl

+main = string.Start
+string.Start::I = string_size string.str
+string.str = "Hello World!"

tests/string_select.exp

+[o]
\ No newline at end of file

tests/string_select.sapl

+main = string.Start
+string.Start::C = string_select string.str 4
+string.str = "Hello World!"

tests/string_slice.exp

+[World]
\ No newline at end of file

tests/string_slice.sapl

+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)

tests/string_update.exp

+[hello world!]
\ No newline at end of file

tests/string_update.sapl

+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)