Skip to content
GitLab
Commit 97edac78 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

implement some primitive functions

parent 17e8091e
Hide whitespace changes
Inline Side-by-side
interpreter/builtin.sapl
View file @ 97edac78
......@@ -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
View file @ 97edac78
#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
View file @ 97edac78
......@@ -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
View file @ 97edac78
......@@ -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
......
Supports Markdown
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