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
56188eaa
Commit
56188eaa
authored
Aug 22, 2015
by
Laszlo Domoszlai
Browse files
first stub on strictness
parent
6ca85fbb
Changes
9
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
56188eaa
#include
<stdio.h>
#include
<stdlib.h>
#include
<stdbool.h>
#include
<assert.h>
#include
"code.h"
#include
"desc.h"
#include
"thunk.h"
#include
"mem.h"
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
,
bool
force
)
{
assert
(
expr
!=
NULL
);
switch
(
expr
->
type
)
{
case
CT_LIT
:
switch
(
expr
->
local_type
)
{
...
...
@@ -40,7 +43,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
}
break
;
case
CT_APP
:
// TODO: check over application
// TODO: enforce strictness in ADT/Record
...
...
@@ -52,7 +55,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
case
VAR_FN
:
{
Desc
*
slice
=
get_slice
(
var
->
f
,
expr
->
nr_args
);
if
(
force
&&
slice
->
type
==
FT_PRIM
)
{
Thunk
args
[
expr
->
nr_args
];
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
...
...
@@ -72,24 +75,24 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
else
if
(
force
&&
slice
->
type
==
FT_FUN
)
{
Thunk
*
args
[
expr
->
nr_args
];
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
args
[
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
false
);
args
[
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
is_strict_fun_arg
((
FunEntry
*
)
slice
,
i
)
);
}
int
old_top
=
stack_top
;
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
pushs
(
args
[
i
]);
}
printf
(
"name: %s
\n
"
,
((
FunEntry
*
)
slice
)
->
name
);
printf
(
"target: %d
\n
"
,
target
);
thunk
=
exec
(((
FunEntry
*
)
slice
)
->
body
,
stack_top
,
target
,
false
);
thunk
=
exec
(((
FunEntry
*
)
slice
)
->
body
,
stack_top
-
1
,
target
,
true
);
stack_top
=
old_top
;
}
else
{
thunk
=
updateF
(
target
,
slice
);
assert
(
thunk
->
desc
->
arity
==
expr
->
nr_args
);
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
thunk
->
_args
[
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
false
);
}
...
...
@@ -103,9 +106,11 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
Desc
*
slice
=
get_slice
(
basethunk
->
desc
->
type
==
FT_SLICE
?
((
SliceEntry
*
)
basethunk
->
desc
)
->
forward_ptr
:
basethunk
->
desc
,
basethunk
->
desc
->
arity
+
expr
->
nr_args
);
thunk
=
updateF
(
target
,
slice
);
assert
(
thunk
->
desc
->
arity
==
basethunk
->
desc
->
arity
+
expr
->
nr_args
);
for
(
int
i
=
0
;
i
<
basethunk
->
desc
->
arity
;
i
++
)
{
thunk
->
_args
[
i
]
=
basethunk
->
_args
[
i
];
}
...
...
@@ -124,6 +129,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
case
CT_SELECT
:
{
Thunk
*
pattern
=
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
NULL
,
true
);
Thunk
*
p
=
pattern
;
pattern
=
eval
(
pattern
);
for
(
int
i
=
0
;
i
<
expr
->
nr_cases
;
i
++
)
{
...
...
@@ -141,7 +147,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
// Fall through on purpose
case
SC_DEFAULT
:
return
exec
(
caseEntry
->
body
,
frame_ptr
,
target
,
f
als
e
);
return
exec
(
caseEntry
->
body
,
frame_ptr
,
target
,
f
orc
e
);
default:
printf
(
"Exec: Unhandled entry type in CT_SELECT"
);
exit
(
-
1
);
...
...
@@ -153,11 +159,11 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
exit
(
-
1
);
}
case
CT_IF
:
{
Thunk
*
tmp
=
(
Thunk
*
)
malloc
(
sizeof
(
Thunk
))
;
tmp
->
desc
=
(
Desc
*
)
__BOOL__
;
{
Thunk
tmp
;
tmp
.
desc
=
(
Desc
*
)
__BOOL__
;
Thunk
*
cond
=
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
NULL
,
true
);
Thunk
*
cond
=
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
&
tmp
,
true
);
cond
=
eval
(
cond
);
if
(
readB
(
cond
))
{
...
...
interpreter/desc.c
View file @
56188eaa
#include
"desc.h"
#include
<stdio.h>
#include
<stdlib.h>
#include
<stdbool.h>
#include
<assert.h>
#include
"desc.h"
#include
"khash.h"
#include
"mem.h"
...
...
@@ -32,9 +34,15 @@ Desc* find_desc(char* fn) {
}
Desc
*
get_slice
(
Desc
*
f
,
int
nrargs
)
{
assert
(
nrargs
<=
f
->
arity
);
return
&
(((
SliceEntry
*
)
f
)[
-
(
f
->
arity
-
nrargs
)].
base
);
}
bool
is_strict_fun_arg
(
FunEntry
*
f
,
int
nr_arg
)
{
return
(
f
->
strictness
&
1
<<
(
f
->
base
.
arity
-
nr_arg
-
1
))
>
0
;
}
FunEntry
*
alloc_prim
(
char
*
name
)
{
int
len
=
strlen
(
name
);
FunEntry
*
entry
=
(
FunEntry
*
)
alloc_desc
(
sizeof
(
FunEntry
)
+
len
+
1
);
...
...
interpreter/desc.h
View file @
56188eaa
...
...
@@ -78,6 +78,8 @@ Desc* find_desc(char* fn);
Desc
*
get_slice
(
Desc
*
f
,
int
nrargs
);
bool
is_strict_fun_arg
(
FunEntry
*
f
,
int
nr_arg
);
extern
struct
FunEntry
*
__INT__
;
extern
struct
FunEntry
*
__BOOL__
;
extern
struct
FunEntry
*
__CHAR__
;
...
...
interpreter/main.c
View file @
56188eaa
#include
<stdio.h>
#include
<stdbool.h>
#include
<string.h>
#include
"desc.h"
...
...
@@ -55,22 +55,25 @@ int main() {
// 44
// char* funstream = "160 F13 example.Start0 0 AF11 example.map2 VF11 example.incAF17 _predefined._Cons2 LI1 AF17 _predefined._Cons2 LI2 AF17 _predefined._Cons2 LI3 VF16 _predefined._Nil36 F11 example.inc1 1 AF3 add2 VA0 LI1 148 F11 example.map2 1 SVA0 2 C16 _predefined._NilVF16 _predefined._NilC17 _predefined._ConsAF17 _predefined._Cons2 AA1 1 VL0 AF11 example.map2 VA1 VL1 50 A2 17 _predefined._Cons2 0 16 _predefined._Nil0 0 ";
// [_predefined._Cons [2] [_predefined._Cons [3] [_predefined._Cons [4] [_predefined._Nil]]]]
char
*
funstream
=
"4
3
F13 example.Start0 0 AF11 example.fib1 LI
5
119 F11 example.fib1 1 IAF2 lt2 VA0 LI2 LI1 AF3 add2 AF11 example.fib1 AF3 sub2 VA0 LI1 AF11 example.fib1 AF3 sub2 VA0 LI2 "
;
//
char* funstream = "4
4
F13 example.Start0 0 AF11 example.fib1 LI
36
119 F11 example.fib1 1 IAF2 lt2 VA0 LI2 LI1 AF3 add2 AF11 example.fib1 AF3 sub2 VA0 LI1 AF11 example.fib1 AF3 sub2 VA0 LI2 ";
// fib
//
char* funstream = "29 F9 Braun.int1 1 IVA0 LI1 LI0 27 F9 Braun.and2 2 IVA1 VA0 L099 F9 Braun.all2 1 SVA0 2 C9 Flite.NilL1C10 Flite.ConsAF9 Braun.and2 AA1 1 VL0 AF9 Braun.all2 VA1 VL1 98 F16 Braun._c;39;3_203 4 IAF3 eqB2 VA2 L0L0IAF3 eqB2 VA2 L1AF14 Braun.equal_182 VA1 VA0 VF7 nomatch175 F14 Braun.equal_182 3 SVA1 2 C9 Flite.NilSVA0 2 C9 Flite.NilL1C10 Flite.ConsL0C10 Flite.ConsSVA0 2 C9 Flite.NilL0C10 Flite.ConsAF16 Braun._c;39;3_203 AF3 eqI2 VL0 VL2 VL1 VL3 176 F9 Braun.ilv2 3 SVA1 2 C9 Flite.NilVA0 C10 Flite.ConsSVA0 2 C9 Flite.NilAF10 Flite.Cons2 VL0 VL1 C10 Flite.ConsAF10 Flite.Cons2 VL0 AF10 Flite.Cons2 VL2 AF9 Braun.ilv2 VL1 VL3 153 F12 Braun.toList1 1 SVA0 2 C11 Braun.EmptyVF9 Flite.NilC12 Braun.BranchAF10 Flite.Cons2 VL0 AF9 Braun.ilv2 AF12 Braun.toList1 VL1 AF12 Braun.toList1 VL2 40 A2 11 Braun.Empty0 0 12 Braun.Branch3 0 167 F12 Braun.insert2 1 SVA0 2 C11 Braun.EmptyAF12 Braun.Branch3 VA1 VF11 Braun.EmptyVF11 Braun.EmptyC12 Braun.BranchAF12 Braun.Branch3 VA1 AF12 Braun.insert2 VL0 VL2 VL1 119 F14 Braun.fromList1 1 SVA0 2 C9 Flite.NilVF11 Braun.EmptyC10 Flite.ConsAF12 Braun.insert2 VL0 AF14 Braun.fromList1 VL1 90 F13 Braun.prop_171 1 AF14 Braun.equal_182 VA0 AF12 Braun.toList1 AF14 Braun.fromList1 VA0 118 F15 Braun.replicate2 2 IAF3 eqI2 VA1 LI0 VF9 Flite.NilAF10 Flite.Cons2 VA0 AF15 Braun.replicate2 AF3 sub2 VA1 LI1 VA0 44 F11 Braun.<=_162 3 AF3 not1 AF2 lt2 VA0 VA1 35 A2 9 Flite.Nil0 0 10 Flite.Cons2 0 121 F12 Braun.fromTo2 3 IAF11 Braun.<=_162 VA1 VA0 AF10 Flite.Cons2 VA1 AF12 Braun.fromTo2 AF3 add2 VA1 LI1 VA0 VF9 Flite.Nil125 F11 Braun.Start0 0 AF9 Braun.int1 AF9 Braun.all2 VF13 Braun.prop_17AF15 Braun.replicate2 LI6000 AF12 Braun.fromTo2 LI0 LI255 27 F4 main0 0 VF11 Braun.Start";
char
*
funstream
=
"29 F9 Braun.int1 1 IVA0 LI1 LI0 27 F9 Braun.and2 2 IVA1 VA0 L099 F9 Braun.all2 1 SVA0 2 C9 Flite.NilL1C10 Flite.ConsAF9 Braun.and2 AA1 1 VL0 AF9 Braun.all2 VA1 VL1 98 F16 Braun._c;39;3_203 4 IAF3 eqB2 VA2 L0L0IAF3 eqB2 VA2 L1AF14 Braun.equal_182 VA1 VA0 VF7 nomatch175 F14 Braun.equal_182 3 SVA1 2 C9 Flite.NilSVA0 2 C9 Flite.NilL1C10 Flite.ConsL0C10 Flite.ConsSVA0 2 C9 Flite.NilL0C10 Flite.ConsAF16 Braun._c;39;3_203 AF3 eqI2 VL0 VL2 VL1 VL3 176 F9 Braun.ilv2 3 SVA1 2 C9 Flite.NilVA0 C10 Flite.ConsSVA0 2 C9 Flite.NilAF10 Flite.Cons2 VL0 VL1 C10 Flite.ConsAF10 Flite.Cons2 VL0 AF10 Flite.Cons2 VL2 AF9 Braun.ilv2 VL1 VL3 153 F12 Braun.toList1 1 SVA0 2 C11 Braun.EmptyVF9 Flite.NilC12 Braun.BranchAF10 Flite.Cons2 VL0 AF9 Braun.ilv2 AF12 Braun.toList1 VL1 AF12 Braun.toList1 VL2 40 A2 11 Braun.Empty0 0 12 Braun.Branch3 0 167 F12 Braun.insert2 1 SVA0 2 C11 Braun.EmptyAF12 Braun.Branch3 VA1 VF11 Braun.EmptyVF11 Braun.EmptyC12 Braun.BranchAF12 Braun.Branch3 VA1 AF12 Braun.insert2 VL0 VL2 VL1 119 F14 Braun.fromList1 1 SVA0 2 C9 Flite.NilVF11 Braun.EmptyC10 Flite.ConsAF12 Braun.insert2 VL0 AF14 Braun.fromList1 VL1 90 F13 Braun.prop_171 1 AF14 Braun.equal_182 VA0 AF12 Braun.toList1 AF14 Braun.fromList1 VA0 118 F15 Braun.replicate2 2 IAF3 eqI2 VA1 LI0 VF9 Flite.NilAF10 Flite.Cons2 VA0 AF15 Braun.replicate2 AF3 sub2 VA1 LI1 VA0 44 F11 Braun.<=_162 3 AF3 not1 AF2 lt2 VA0 VA1 35 A2 9 Flite.Nil0 0 10 Flite.Cons2 0 121 F12 Braun.fromTo2 3 IAF11 Braun.<=_162 VA1 VA0 AF10 Flite.Cons2 VA1 AF12 Braun.fromTo2 AF3 add2 VA1 LI1 VA0 VF9 Flite.Nil125 F11 Braun.Start0 0 AF9 Braun.int1 AF9 Braun.all2 VF13 Braun.prop_17AF15 Braun.replicate2 LI6000 AF12 Braun.fromTo2 LI0 LI255 27 F4 main0 0 VF11 Braun.Start"
;
//braun
printf
(
"sizeof(int): %d, sizeof(long): %d, sizeof(void*): %d, sizeof(Thunk): %d
\n\n
"
,
sizeof
(
int
),
sizeof
(
long
),
sizeof
(
void
*
),
sizeof
(
Thunk
));
int
nrfuns
=
parse
(
&
funstream
,
strlen
(
funstream
));
printf
(
"Number of functions parsed: %d
\n
"
,
nrfuns
);
// TODO: put it into a special "expression" space, instead of "code"
char
*
exprstream
=
"VF13 example.Start"
;
//
char *exprstream = "VF11 Braun.Start";
//
char *exprstream = "VF13 example.Start";
char
*
exprstream
=
"VF11 Braun.Start"
;
Code
*
expr
=
parseTerm
(
&
exprstream
);
Thunk
*
res
=
exec
(
expr
,
stack_top
,
NULL
,
true
);
eval
(
res
);
print
(
res
,
true
);
...
...
interpreter/mem.c
View file @
56188eaa
#include
<stdlib.h>
#include
<stdio.h>
#include
<assert.h>
#include
"mem.h"
int
desc_alloc
;
int
code_alloc
;
int
heap_alloc
;
int
nr_heap_alloc
;
int
stack_top
;
Thunk
*
stack
[
STACK_SIZE
];
#define heap_size 1024*1024*1024
char
*
heap_start
;
void
print_stat
()
{
printf
(
"
\n\n
allocation:
\n
"
);
printf
(
"desc: %d
\n
"
,
desc_alloc
);
printf
(
"code: %d
\n
"
,
code_alloc
);
printf
(
"heap: %d
\n
"
,
heap_alloc
);
printf
(
"heap: %d
(%d thunks)
\n
"
,
heap_alloc
,
nr_
heap_alloc
);
}
void
init_mem
()
{
desc_alloc
=
0
;
code_alloc
=
0
;
heap_alloc
=
0
;
nr_heap_alloc
=
0
;
stack_top
=
0
;
heap_start
=
(
char
*
)
malloc
(
heap_size
);
assert
(
heap_start
!=
NULL
);
}
void
*
alloc_desc
(
int
size
)
{
...
...
@@ -36,6 +45,13 @@ void* alloc_code(int size) {
}
void
*
alloc_heap
(
int
size
)
{
char
*
curr
=
heap_start
+
heap_alloc
;
heap_alloc
+=
size
;
return
malloc
(
size
);
nr_heap_alloc
++
;
assert
(
heap_alloc
<
heap_size
);
return
curr
;
}
\ No newline at end of file
interpreter/mem.h
View file @
56188eaa
...
...
@@ -3,7 +3,7 @@
#include
"thunk.h"
#define STACK_SIZE
1024
#define STACK_SIZE
1024
0
extern
int
stack_top
;
extern
Thunk
*
stack
[
STACK_SIZE
];
...
...
interpreter/prim.c
View file @
56188eaa
...
...
@@ -74,7 +74,7 @@ struct Thunk* __not(Thunk* target) {
return
updateB
(
target
,
!
readB
(
arg1
));
}
PrimEntry
*
add_prim
(
int
arity
,
int
strictness
,
char
*
name
,
Thunk
*
(
*
exec
)(
Thunk
*
))
{
void
add_prim
(
int
arity
,
int
strictness
,
char
*
name
,
Thunk
*
(
*
exec
)(
Thunk
*
))
{
int
nameLength
=
strlen
(
name
);
// before the PrimEntry there are "arity" number of SliceEntries
...
...
interpreter/thunk.c
View file @
56188eaa
#include
<stdio.h>
#include
<stdlib.h>
#include
<stdbool.h>
#include
<assert.h>
#include
"thunk.h"
#include
"desc.h"
...
...
@@ -37,6 +38,8 @@ int printDesc(Desc* f) {
}
Thunk
*
forward_to
(
Thunk
*
target
,
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
if
(
target
!=
NULL
)
{
target
->
desc
=
NULL
;
target
->
_forward_ptr
=
thunk
;
...
...
@@ -47,9 +50,11 @@ Thunk* forward_to(Thunk* target, Thunk* thunk) {
}
int
thunk_size
(
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
if
(
thunk
->
desc
==
NULL
||
thunk
->
desc
->
type
==
FT_BOXED_LIT
)
{
if
(
thunk
->
desc
==
(
Desc
*
)
__STRING__
||
thunk
->
desc
==
(
Desc
*
)
__ARRAY__
)
{
printf
(
"tunk_size: unhandled literal type
\n
"
);
printf
(
"t
h
unk_size: unhandled literal type
\n
"
);
exit
(
-
1
);
}
...
...
@@ -69,6 +74,8 @@ struct Thunk* updateI(Thunk* target, int i) {
}
int
readI
(
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
if
(
thunk
->
desc
!=
(
Desc
*
)
__INT__
)
{
printf
(
"readI: not an integer
\n
"
);
printDesc
(
thunk
->
desc
);
...
...
@@ -88,6 +95,8 @@ struct Thunk* updateB(Thunk* target, int b) {
}
int
readB
(
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
if
(
thunk
->
desc
!=
(
Desc
*
)
__BOOL__
)
{
printf
(
"readB: not a boolean
\n
"
);
exit
(
-
1
);
...
...
@@ -97,6 +106,8 @@ int readB(Thunk* thunk) {
}
struct
Thunk
*
updateF
(
Thunk
*
target
,
Desc
*
f
)
{
assert
(
f
!=
NULL
);
Thunk
*
thunk
=
target
;
int
newsize
=
max
(
sizeof
(
Thunk
),
sizeof
(
Desc
*
)
+
sizeof
(
Thunk
*
)
*
f
->
arity
);
...
...
@@ -110,11 +121,15 @@ struct Thunk* updateF(Thunk* target, Desc* f) {
}
}
assert
(
thunk
!=
NULL
);
thunk
->
desc
=
f
;
return
thunk
;
}
struct
Thunk
*
eval
(
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
while
(
true
)
{
while
(
thunk
->
desc
==
NULL
)
{
...
...
@@ -178,6 +193,7 @@ void print(Thunk* thunk, bool force) {
}
}
else
{
printf
(
"print: unhandled BOXED LIT
\n
"
);
printDesc
(
thunk
->
desc
);
exit
(
-
1
);
}
}
else
{
...
...
interpreter/thunk.h
View file @
56188eaa
...
...
@@ -4,7 +4,9 @@
#include
"desc.h"
#include
"code.h"
typedef
struct
Thunk
{
#pragma pack(push, 1)
typedef
struct
__attribute__
((
packed
))
Thunk
{
struct
Desc
*
desc
;
// NULL, if it is a forward pointer
union
{
...
...
@@ -31,6 +33,7 @@ struct Thunk* updateF(Thunk* target, Desc* f);
struct
Thunk
*
eval
(
Thunk
*
thunk
);
int
printDesc
(
Desc
*
f
);
// Thunk is supposed to be in HNF
void
print
(
Thunk
*
thunk
,
bool
force
);
...
...
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