Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
sapl-interpreter
Commits
97edac78
Commit
97edac78
authored
Feb 22, 2016
by
Laszlo Domoszlai
Browse files
implement some primitive functions
parent
17e8091e
Changes
4
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
,
0
b011
,
1
,
"divI"
,
&
__divI
);
add_prim
(
2
,
0
b011
,
1
,
"gtI"
,
&
__gtI
);
add_prim
(
2
,
0
b011
,
1
,
"geI"
,
&
__geI
);
add_prim
(
2
,
0
b011
,
1
,
"geC"
,
&
__geC
);
add_prim
(
2
,
0
b011
,
1
,
"ltI"
,
&
__ltI
);
add_prim
(
2
,
0
b011
,
1
,
"eqI"
,
&
__eqI
);
add_prim
(
2
,
0
b011
,
1
,
"neqI"
,
&
__neqI
);
add_prim
(
2
,
0
b011
,
1
,
"eqB"
,
&
__eqB
);
add_prim
(
2
,
0
b011
,
1
,
"geC"
,
&
__geC
);
add_prim
(
2
,
0
b011
,
1
,
"ltC"
,
&
__ltC
);
add_prim
(
2
,
0
b011
,
1
,
"eqC"
,
&
__eqC
);
add_prim
(
2
,
0
b011
,
1
,
"addR"
,
&
__addR
);
add_prim
(
2
,
0
b011
,
1
,
"subR"
,
&
__subR
);
add_prim
(
2
,
0
b011
,
1
,
"multR"
,
&
__multR
);
add_prim
(
2
,
0
b011
,
1
,
"divR"
,
&
__divR
);
add_prim
(
2
,
0
b011
,
1
,
"eqB"
,
&
__eqB
);
add_prim
(
1
,
0
b001
,
1
,
"not"
,
&
__not
);
add_prim
(
2
,
0
b011
,
1
,
"and"
,
&
__and
);
add_prim
(
2
,
0
b011
,
1
,
"or"
,
&
__or
);
add_prim
(
2
,
0
b011
,
1
,
"mod"
,
&
__mod
);
add_prim
(
1
,
0
b001
,
1
,
"C2I"
,
&
__C2I
);
add_prim
(
1
,
0
b001
,
1
,
"R2I"
,
&
__R2I
);
add_prim
(
1
,
0
b001
,
1
,
"S2I"
,
&
__S2I
);
add_prim
(
1
,
0
b001
,
1
,
"I2C"
,
&
__I2C
);
add_prim
(
1
,
0
b001
,
1
,
"I2R"
,
&
__I2R
);
add_prim
(
1
,
0
b001
,
1
,
"R2R"
,
&
__R2R
);
add_prim
(
1
,
0
b000
,
0
,
"S2R"
,
&
__S2R
);
add_prim
(
1
,
0
b001
,
0
,
"C2S"
,
&
__C2S
);
add_prim
(
1
,
0
b000
,
1
,
"string_size"
,
&
__string_size
);
add_prim
(
2
,
0
b010
,
1
,
"string_select"
,
&
__string_select
);
add_prim
(
1
,
0
b001
,
0
,
"string_create1"
,
&
__string_create1
);
...
...
@@ -438,7 +619,8 @@ void init_prim() {
add_prim
(
3
,
0
b110
,
0
,
"string_slice"
,
&
__string_slice
);
add_prim
(
2
,
0
b000
,
0
,
"string_append"
,
&
__string_append
);
add_prim
(
2
,
0
b000
,
1
,
"eqS"
,
&
__eqS
);
add_prim
(
1
,
0
b00
1
,
0
,
"
C2
S"
,
&
__
C2
S
);
add_prim
(
2
,
0
b00
0
,
1
,
"
lt
S"
,
&
__
lt
S
);
add_prim
(
1
,
0
b000
,
0
,
"_trace"
,
&
__trace
);
add_prim
(
1
,
0
b000
,
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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment