implement some primitive functions

interpreter/builtin.sapl

@@ -5,10 +5,22 @@ App4 !f a1 a2 a3 a4 = f a1 a2 a3 a4
 App5 !f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5
 
 :: _Tuple2 = _Tuple2 a b
+:: _Tuple3 = _Tuple3 a b c
+:: _Tuple4 = _Tuple4 a b c d
 
 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)
 
 second !f !s = s
-trace !str a = second (_trace str) a 
\ No newline at end of file
+trace !str a = second (_trace str) a 
+
+tupsels2v0 !t = select t (_Tuple2 a0 a1 -> a0)
+tupsels2v1 !t = select t (_Tuple2 a0 a1 -> a1)
+tupsels3v0 !t = select t (_Tuple3 a0 a1 a2 -> a0)
+tupsels3v1 !t = select t (_Tuple3 a0 a1 a2 -> a1)
+tupsels3v2 !t = select t (_Tuple3 a0 a1 a2 -> a2)
+tupsels4v0 !t = select t (_Tuple4 a0 a1 a2 a3 -> a0)
+tupsels4v1 !t = select t (_Tuple4 a0 a1 a2 a3 -> a1)
+tupsels4v2 !t = select t (_Tuple4 a0 a1 a2 a3 -> a2)
+tupsels4v3 !t = select t (_Tuple4 a0 a1 a2 a3 -> a3)
\ No newline at end of file

interpreter/prim.c

 #include <string.h>
+#include <stdlib.h>
 #include <stdio.h>
 
 #include "prim.h"
@@ -32,6 +33,30 @@ void __divI(int dst_idx) {
     target->_int = readI(arg(2)) / readI(arg(1));
 }
 
+void __addR(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = readR(arg(2)) + readR(arg(1));
+}
+
+void __subR(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = readR(arg(2)) - readR(arg(1));
+}
+
+void __multR(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = readR(arg(2)) * readR(arg(1));
+}
+
+void __divR(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = readR(arg(2)) / readR(arg(1));
+}
+
 void __gtI(int dst_idx) {
     Thunk* target = get_dst(dst_idx);
     target->desc = (Desc*) __BOOL__;
@@ -56,6 +81,12 @@ void __geC(int dst_idx) {
     target->_int = readC(arg(2)) >= readC(arg(1));
 }
 
+void __ltC(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __BOOL__;
+    target->_int = readC(arg(2)) < readC(arg(1));
+}
+
 void __eqI(int dst_idx) {
     Thunk* target = get_dst(dst_idx);
     target->desc = (Desc*) __BOOL__;
@@ -116,6 +147,78 @@ void __I2C(int dst_idx) {
     target->_int = (char) readI(arg(1));
 }
 
+void __I2R(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = readI(arg(1));
+}
+
+void __R2R(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = readR(arg(1));
+}
+
+void __R2I(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __INT__;
+    target->_int = (int) readR(arg(1));
+}
+
+void __S2R(int dst_idx) {
+    Thunk* str = 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;
+    }
+
+    char buff[1080];
+    if(length > 1079) length = 1079;
+    memcpy(buff, chars, length);
+    buff[length] = '\0';
+    
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __REAL__;
+    target->_real = strtod(buff, NULL);
+}
+
+void __S2I(int dst_idx) {
+    Thunk* str = 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;
+    }
+
+    char buff[20];
+    if(length > 19) length = 19;
+    memcpy(buff, chars, length);
+    buff[length] = '\0';
+    
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __INT__;
+    target->_int = strtol(buff, NULL, 10);
+}
+
 void __string_size(int dst_idx)
 {
     Thunk* target = get_dst(dst_idx);
@@ -352,6 +455,63 @@ void __eqS(int dst_idx)
     target->_int = eq;    
 }
 
+void __ltS(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 result = length1 == 0;
+    
+    if(length1 > 0 && length2 > 0)
+    {
+        result = length1 < length2;
+        
+        int i = 0;
+        while(i<length1)
+        {
+            if(chars1[i] != chars2[i])
+            {
+                result = chars1[i] < chars2[i];
+                break;
+            }
+            
+            i++;
+        }
+    }
+    
+    target->desc = (Desc*) __BOOL__;
+    target->_int = result;    
+}
+
 void __C2S(int dst_idx) {
     Thunk* target = get_dst(dst_idx);
     Thunk* ch = arg(1);
@@ -385,6 +545,12 @@ void __trace(int dst_idx)
     }
 }
 
+void __abort(int dst_idx)
+{
+    __trace(dst_idx);
+    exit(-1);
+}
+
 void add_prim(int arity, int boxingMap, int unboxableReturn,  char* name, void (*exec)(int)) {
     int nameLength = strlen(name);
 
@@ -417,19 +583,34 @@ void init_prim() {
     add_prim(2, 0b011, 1, "divI", &__divI);
     add_prim(2, 0b011, 1, "gtI", &__gtI);
     add_prim(2, 0b011, 1, "geI", &__geI);
-    add_prim(2, 0b011, 1, "geC", &__geC);    
     add_prim(2, 0b011, 1, "ltI", &__ltI);
     add_prim(2, 0b011, 1, "eqI", &__eqI);
     add_prim(2, 0b011, 1, "neqI", &__neqI);
-    add_prim(2, 0b011, 1, "eqB", &__eqB);
+    
+    add_prim(2, 0b011, 1, "geC", &__geC);    
+    add_prim(2, 0b011, 1, "ltC", &__ltC);
     add_prim(2, 0b011, 1, "eqC", &__eqC);
+
+    add_prim(2, 0b011, 1, "addR", &__addR);
+    add_prim(2, 0b011, 1, "subR", &__subR);
+    add_prim(2, 0b011, 1, "multR", &__multR);
+    add_prim(2, 0b011, 1, "divR", &__divR);    
+    
+    add_prim(2, 0b011, 1, "eqB", &__eqB);
     add_prim(1, 0b001, 1, "not", &__not);
     add_prim(2, 0b011, 1, "and", &__and); 
     add_prim(2, 0b011, 1, "or", &__or); 
     add_prim(2, 0b011, 1, "mod", &__mod);
+    
     add_prim(1, 0b001, 1, "C2I", &__C2I);
+    add_prim(1, 0b001, 1, "R2I", &__R2I);
+    add_prim(1, 0b001, 1, "S2I", &__S2I);
     add_prim(1, 0b001, 1, "I2C", &__I2C);
-    
+    add_prim(1, 0b001, 1, "I2R", &__I2R);
+    add_prim(1, 0b001, 1, "R2R", &__R2R);
+    add_prim(1, 0b000, 0, "S2R", &__S2R);
+    add_prim(1, 0b001, 0, "C2S", &__C2S);
+            
     add_prim(1, 0b000, 1, "string_size", &__string_size);
     add_prim(2, 0b010, 1, "string_select", &__string_select);
     add_prim(1, 0b001, 0, "string_create1", &__string_create1);
@@ -438,7 +619,8 @@ void init_prim() {
     add_prim(3, 0b110, 0, "string_slice", &__string_slice);
     add_prim(2, 0b000, 0, "string_append", &__string_append);
     add_prim(2, 0b000, 1, "eqS", &__eqS);
-    add_prim(1, 0b001, 0, "C2S", &__C2S);    
+    add_prim(2, 0b000, 1, "ltS", &__ltS);
     
     add_prim(1, 0b000, 0, "_trace", &__trace);
+    add_prim(1, 0b000, 0, "abort", &__abort);
 }

interpreter/thunk.c

@@ -44,6 +44,18 @@ char readC(Thunk* thunk) {
     
     return (char) thunk->_int;
 }
+
+double readR(Thunk* thunk) {
+    assert(thunk != NULL);
+    
+    if (thunk->desc != (Desc*) __REAL__) {
+        printf("readC: not a real: ");
+        printDesc(thunk->desc);
+        exit(-1);
+    }
+    
+    return (char) thunk->_real;
+}
 #endif
     
 bool is_hnf(Thunk* thunk)
@@ -71,6 +83,8 @@ void print(bool force) {
             }
         } else if ((FunEntry*) thunk->desc == __CHAR__) {
             printf("%c", (char) thunk->_int);
+        } else if ((FunEntry*) thunk->desc == __REAL__) {
+            printf("%G", thunk->_real);            
         } else if ((FunEntry*) thunk->desc == __STRING_PTR__) {
             for(int i=0; i< thunk->_string_ptr->length; i++)
             {

interpreter/thunk.h

@@ -54,12 +54,14 @@ typedef struct __attribute__((packed)) Thunk {
 int readI(Thunk* thunk);
 int readB(Thunk* thunk);
 char readC(Thunk* thunk);
+double readR(Thunk* thunk);
 
 #else
 
 #define readI(thunk) thunk->_int
 #define readB(thunk) thunk->_int
 #define readC(thunk) thunk->_int
+#define readR(thunk) thunk->_real
 
 #endif