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
b337916d
Commit
b337916d
authored
Aug 25, 2015
by
Laszlo Domoszlai
Browse files
add tail call optimization
parent
420c41f9
Changes
4
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
b337916d
...
...
@@ -8,152 +8,179 @@
#include
"thunk.h"
#include
"mem.h"
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
,
bool
force
)
void
exec
(
Code
*
expr
,
int
frame_ptr
,
int
root_frame_ptr
,
Thunk
*
target
,
bool
force
)
{
assert
(
expr
!=
NULL
);
switch
(
expr
->
type
)
{
case
CT_LIT
:
switch
(
expr
->
local_type
)
{
case
LIT_INT
:
return
updateI
(
target
,
((
LitEntry
*
)
expr
)
->
_int
);
case
LIT_BOOL
:
return
updateB
(
target
,
((
LitEntry
*
)
expr
)
->
_bool
);
default:
printf
(
"Exec: Unhandled LIT type"
);
exit
(
-
1
);
}
break
;
case
CT_VAR
:
if
(
expr
->
local_type
==
VAR_LOCAL
)
{
Thunk
*
var
=
local
(
frame_ptr
,
((
VarEntry
*
)
expr
)
->
index
);
return
forward_to
(
target
,
var
);
}
else
{
return
updateF
(
target
,
get_slice
(((
VarEntry
*
)
expr
)
->
f
,
0
));
}
break
;
case
CT_APP
:
// TODO: check over application
// TODO: enforce strictness in ADT/Record
VarEntry
*
var
;
var
=
((
AppEntry
*
)
expr
)
->
var
;
Thunk
*
thunk
;
if
(
var
->
base
.
local_type
==
VAR_LOCAL
)
{
Thunk
*
basethunk
=
eval
(
local
(
frame_ptr
,
var
->
index
));
Desc
*
slice
=
get_slice
(
basethunk
->
desc
->
type
==
FT_SLICE
?
((
SliceEntry
*
)
basethunk
->
desc
)
->
forward_ptr
:
basethunk
->
desc
,
basethunk
->
desc
->
arity
+
expr
->
nr_args
);
while
(
1
)
{
switch
(
expr
->
type
)
{
case
CT_LIT
:
stack_top_a
=
root_frame_ptr
;
thunk
=
updateF
(
target
,
slice
);
assert
(
thunk
->
desc
->
arity
==
basethunk
->
desc
->
arity
+
expr
->
nr_args
);
switch
(
expr
->
local_type
)
{
case
LIT_INT
:
push_a
(
updateI
(
target
,
((
LitEntry
*
)
expr
)
->
_int
));
return
;
case
LIT_BOOL
:
push_a
(
updateB
(
target
,
((
LitEntry
*
)
expr
)
->
_bool
));
return
;
default:
printf
(
"Exec: Unhandled LIT type"
);
exit
(
-
1
);
}
break
;
case
CT_VAR
:
stack_top_a
=
root_frame_ptr
;
for
(
int
i
=
0
;
i
<
basethunk
->
desc
->
arity
;
i
++
)
{
thunk
->
_args
[
i
]
=
basethunk
->
_args
[
i
];
if
(
expr
->
local_type
==
VAR_LOCAL
)
{
push_a
(
forward_to
(
target
,
local
(
frame_ptr
,
((
VarEntry
*
)
expr
)
->
index
)));
return
;
}
else
{
push_a
(
updateF
(
target
,
get_slice
(((
VarEntry
*
)
expr
)
->
f
,
0
)));
return
;
}
break
;
case
CT_APP
:
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
thunk
->
_args
[
basethunk
->
desc
->
arity
+
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
false
);
}
// TODO: check over application
// TODO: enforce strictness in ADT/Record
return
thunk
;
}
else
{
Desc
*
slice
=
get_slice
(
var
->
f
,
expr
->
nr_args
);
if
(
force
&&
slice
->
type
==
FT_PRIM
)
{
Thunk
args
[
expr
->
nr_args
];
int
old_top
=
stack_top_a
;
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
push_a
(
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
&
args
[
i
],
true
));
}
VarEntry
*
var
;
var
=
((
AppEntry
*
)
expr
)
->
var
;
Thunk
*
thunk
;
thunk
=
((
PrimEntry
*
)
slice
)
->
exec
(
target
);
if
(
var
->
base
.
local_type
==
VAR_LOCAL
)
{
Thunk
*
basethunk
=
eval
(
local
(
frame_ptr
,
var
->
index
));
stack_top_a
=
old_top
;
}
else
if
(
force
&&
slice
->
type
==
FT_FUN
)
{
Desc
*
slice
=
get_slice
(
basethunk
->
desc
->
type
==
FT_SLICE
?
((
SliceEntry
*
)
basethunk
->
desc
)
->
forward_ptr
:
basethunk
->
desc
,
basethunk
->
desc
->
arity
+
expr
->
nr_args
);
int
new_frame_ptr
=
stack_top_a
;
thunk
=
updateF
(
target
,
slice
)
;
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
push_a
(
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
is_strict_fun_arg
((
FunEntry
*
)
slice
,
i
)));
}
assert
(
thunk
->
desc
->
arity
==
basethunk
->
desc
->
arity
+
expr
->
nr_args
);
thunk
=
exec
(((
FunEntry
*
)
slice
)
->
body
,
new_frame_ptr
,
target
,
true
);
for
(
int
i
=
0
;
i
<
basethunk
->
desc
->
arity
;
i
++
)
{
thunk
->
_args
[
i
]
=
basethunk
->
_args
[
i
];
}
stack_top_a
=
new_frame_ptr
;
}
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
);
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
stack_top_a
,
NULL
,
false
);
thunk
->
_args
[
basethunk
->
desc
->
arity
+
i
]
=
pop_a
();
}
stack_top_a
=
root_frame_ptr
;
push_a
(
thunk
);
return
;
}
return
thunk
;
}
break
;
case
CT_SELECT
:
{
Thunk
*
pattern
=
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
NULL
,
true
);
pattern
=
eval
(
pattern
);
else
{
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
++
)
{
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
stack_top_a
,
&
args
[
i
],
true
);
}
thunk
=
((
PrimEntry
*
)
slice
)
->
exec
(
target
);
stack_top_a
=
root_frame_ptr
;
push_a
(
thunk
);
return
;
}
else
if
(
force
&&
slice
->
type
==
FT_FUN
)
{
for
(
int
i
=
0
;
i
<
expr
->
nr_cases
;
i
++
)
{
SelectCaseEntry
*
caseEntry
=
&
((
SelectEntry
*
)
expr
)
->
cases
[
i
];
int
new_frame_ptr
=
stack_top_a
;
switch
(
caseEntry
->
type
)
{
case
SC_CONS
:
// Pattern match
if
((
Desc
*
)
caseEntry
->
cons
!=
pattern
->
desc
)
continue
;
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
stack_top_a
,
NULL
,
is_strict_fun_arg
((
FunEntry
*
)
slice
,
i
));
}
// Put the constructor arguments to the stack if matches
for
(
int
i
=
0
;
i
<
pattern
->
desc
->
arity
;
i
++
)
{
push_a
(
pattern
->
_args
[
i
]);
expr
=
((
FunEntry
*
)
slice
)
->
body
;
frame_ptr
=
new_frame_ptr
;
continue
;
}
else
{
thunk
=
updateF
(
target
,
slice
);
assert
(
thunk
->
desc
->
arity
==
expr
->
nr_args
);
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
stack_top_a
,
NULL
,
false
);
thunk
->
_args
[
i
]
=
pop_a
();
}
stack_top_a
=
root_frame_ptr
;
push_a
(
thunk
);
return
;
}
}
break
;
case
CT_SELECT
:
{
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
stack_top_a
,
NULL
,
true
);
Thunk
*
pattern
=
eval
(
pop_a
());
// Fall through on purpose
case
SC_DEFAULT
:
return
exec
(
caseEntry
->
body
,
frame_ptr
,
target
,
force
);
default:
printf
(
"Exec: Unhandled entry type in CT_SELECT"
);
exit
(
-
1
);
bool
handled
=
false
;
for
(
int
i
=
0
;
i
<
expr
->
nr_cases
;
i
++
)
{
SelectCaseEntry
*
caseEntry
=
&
((
SelectEntry
*
)
expr
)
->
cases
[
i
];
if
(
caseEntry
->
type
==
SC_CONS
)
{
// Pattern match
if
((
Desc
*
)
caseEntry
->
cons
!=
pattern
->
desc
)
continue
;
// Put the constructor arguments to the stack if matches
for
(
int
i
=
0
;
i
<
pattern
->
desc
->
arity
;
i
++
)
{
push_a
(
pattern
->
_args
[
i
]);
}
handled
=
true
;
expr
=
caseEntry
->
body
;
break
;
}
else
if
(
caseEntry
->
type
==
SC_LIT
)
{
printf
(
"Exec: Unhandled entry type in CT_SELECT (SC_LIT)"
);
exit
(
-
1
);
}
// must be SC_DEFAULT now
handled
=
true
;
expr
=
caseEntry
->
body
;
break
;
}
}
printf
(
"Exec: no select cases matches"
);
print
(
pattern
,
false
);
exit
(
-
1
);
}
case
CT_IF
:
{
Thunk
tmp
;
tmp
.
desc
=
(
Desc
*
)
__BOOL__
;
if
(
handled
)
continue
;
printf
(
"Exec: no select cases matches"
);
print
(
pattern
,
false
);
exit
(
-
1
);
}
case
CT_IF
:
{
Thunk
tmp
;
tmp
.
desc
=
(
Desc
*
)
__BOOL__
;
Thunk
*
cond
=
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
&
tmp
,
true
);
cond
=
eval
(
cond
);
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
stack_top_a
,
&
tmp
,
true
);
Thunk
*
cond
=
eval
(
pop_a
()
);
if
(
readB
(
cond
))
{
return
exec
(((
IfEntry
*
)
expr
)
->
texpr
,
frame_ptr
,
target
,
force
);
if
(
readB
(
cond
))
{
expr
=
((
IfEntry
*
)
expr
)
->
texpr
;
continue
;
}
else
{
expr
=
((
IfEntry
*
)
expr
)
->
fexpr
;
continue
;
}
}
else
{
return
exec
(((
IfEntry
*
)
expr
)
->
fexpr
,
frame_ptr
,
target
,
force
);
default:
printf
(
"Exec: Unhandled CODE type"
);
exit
(
-
1
);
}
}
default:
printf
(
"Exec: Unhandled CODE type"
);
exit
(
-
1
);
}
return
NULL
;
}
}
interpreter/code.h
View file @
b337916d
...
...
@@ -85,6 +85,6 @@ struct IfEntry {
struct
Code
*
fexpr
;
};
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
,
bool
force
);
void
exec
(
Code
*
expr
,
int
frame_ptr
,
int
root_frame_ptr
,
struct
Thunk
*
target
,
bool
force
);
#endif // __CODE_H
\ No newline at end of file
interpreter/main.c
View file @
b337916d
...
...
@@ -68,8 +68,8 @@ int main ( int argc, char *argv[] )
gettimeofday
(
&
t1
,
NULL
);
#endif
Thunk
*
res
=
exec
(
expr
,
stack_top_a
,
NULL
,
true
);
eval
(
res
);
exec
(
expr
,
stack_top_a
,
stack_top_a
,
NULL
,
true
);
Thunk
*
res
=
eval
(
pop_a
()
);
#ifdef DEBUG
gettimeofday
(
&
t2
,
NULL
);
...
...
interpreter/thunk.c
View file @
b337916d
...
...
@@ -153,9 +153,8 @@ struct Thunk* eval(Thunk* thunk) {
// TODO: handle strictness
push_a
(
thunk
->
_args
[
i
]);
}
thunk
=
exec
(((
FunEntry
*
)
thunk
->
desc
)
->
body
,
frame_ptr
,
thunk
,
true
);
stack_top_a
=
frame_ptr
;
exec
(((
FunEntry
*
)
thunk
->
desc
)
->
body
,
frame_ptr
,
frame_ptr
,
thunk
,
true
);
thunk
=
pop_a
();
break
;
case
FT_PRIM
:
frame_ptr
=
stack_top_a
;
...
...
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