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
b5b61142
Commit
b5b61142
authored
Oct 13, 2015
by
Laszlo Domoszlai
Browse files
better SELECT
parent
d525bab2
Changes
8
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
b5b61142
...
...
@@ -138,7 +138,8 @@ void set_create_thunk_fun(Code* code)
case
CT_THUNK
:
code
->
create_thunk
=
create_thunk_thunk
;
break
;
case
CT_SELECT
:
case
CT_SELECT_ADT
:
case
CT_SELECT_LIT
:
case
CT_IF
:
code
->
create_thunk
=
NULL
;
break
;
...
...
@@ -503,86 +504,56 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
destroy_stack_frame_b
(
root_frame_ptr_b
);
return
;
}
case
CT_SELECT
:
{
bool
handled
=
false
;
Thunk
*
pattern
=
alloc_b
();
pattern
->
desc
=
(
Desc
*
)
__STACK_PLACEHOLDER__
;
push_a
(
pattern
);
case
CT_SELECT_LIT
:
{
Thunk
*
lit
=
alloc_b
();
push_a
(
lit
);
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
stack_top_a
);
pattern
=
pop_a
();
lit
=
pop_a
();
int
i
=
0
;
do
{
assert
(
is_hnf
(
pattern
));
for
(;
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
]);
}
}
else
if
(
caseEntry
->
type
==
SC_DEFAULT
)
{
// accept it
}
else
if
(
caseEntry
->
type
==
SC_LIT
)
{
assert
(
caseEntry
->
lit
->
thunk
.
desc
!=
(
Desc
*
)
__INT__
);
if
(
caseEntry
->
lit
->
thunk
.
_int
!=
pattern
->
_int
)
continue
;
}
// must be SC_DEFAULT now
expr
=
caseEntry
->
body
;
if
(
expr
->
type
==
CT_SELECT
)
{
i
=-
1
;
((
SelectEntry
*
)
expr
)
->
saved_pattern
=
pattern
;
pattern
=
alloc_b
();
pattern
->
desc
=
(
Desc
*
)
__STACK_PLACEHOLDER__
;
push_a
(
pattern
);
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
stack_top_a
);
pattern
=
pop_a
();
continue
;
}
handled
=
true
;
break
;
}
bool
handled
=
false
;
for
(
int
i
=
0
;
i
<
expr
->
nr_cases
;
i
++
)
{
SelectLitCaseEntry
*
caseEntry
=
&
((
SelectEntry
*
)
expr
)
->
cases
[
i
];
if
(
!
handled
)
// NULL means "default", we accept it anyway
if
(
caseEntry
->
lit
!=
NULL
)
{
if
(((
SelectEntry
*
)
expr
)
->
fallback
!=
NULL
)
{
expr
=
(
Code
*
)
((
SelectEntry
*
)
expr
)
->
fallback
;
i
=
((
SelectEntry
*
)
expr
)
->
fallbackidx
;
pattern
=
((
SelectEntry
*
)
expr
)
->
saved_pattern
;
}
else
{
printf
(
"Exec: no select cases matches"
);
print
(
pattern
,
false
);
exit
(
-
1
);
}
assert
(
caseEntry
->
lit
->
thunk
.
desc
!=
(
Desc
*
)
__INT__
);
if
(
caseEntry
->
lit
->
thunk
.
_int
!=
lit
->
_int
)
continue
;
}
}
while
(
!
handled
);
// must be SC_DEFAULT now
handled
=
true
;
expr
=
caseEntry
->
body
;
break
;
}
if
(
handled
)
continue
;
not_implemented
(
"fallback"
);
}
case
CT_SELECT_ADT
:
{
Thunk
*
cons
=
alloc_b
();
cons
->
desc
=
(
Desc
*
)
__INT__
;
push_a
(
cons
);
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
stack_top_a
);
cons
=
pop_a
();
expr
=
((
SelectEntry
*
)
expr
)
->
bodies
[((
ADTEntry
*
)
cons
->
desc
)
->
idx
];
if
(
expr
!=
NULL
)
{
for
(
int
i
=
0
;
i
<
cons
->
desc
->
arity
;
i
++
)
{
push_a
(
cons
->
_args
[
i
]);
}
continue
;
}
continue
;
not_implemented
(
"fallback"
)
;
}
case
CT_IF
:
{
...
...
interpreter/code.h
View file @
b5b61142
...
...
@@ -9,7 +9,7 @@ enum CodeType {
CT_APP_PRIM2
,
CT_APP_PRIM_ST
,
CT_APP_PRIM_TS
,
CT_APP_PRIM_SS
,
CT_APP_PRIM_TA
,
CT_APP_PRIM_AT
,
CT_APP_PRIM_AS
,
CT_APP_PRIM_SA
,
CT_APP_THUNK
,
CT_APP_DYN
,
CT_APP_FUN
,
CT_APP_FUN1
,
CT_APP_FUN2
,
CT_SELECT
,
CT_IF
,
CT_SELECT
_ADT
,
CT_SELECT_LIT
,
CT_IF
,
CT_THUNK
};
...
...
@@ -40,33 +40,20 @@ struct AppEntry {
struct
Code
*
args
[];
};
#define SC_CONS 1
#define SC_LIT 2
#define SC_DEFAULT 3
struct
SelectCaseEntry
{
int
type
;
struct
Code
*
body
;
Code
*
parent
;
// SelectEntry
union
{
struct
ADTEntry
*
cons
;
struct
ThunkEntry
*
lit
;
};
struct
SelectLitCaseEntry
{
struct
Code
*
body
;
struct
ThunkEntry
*
lit
;
// NULL -> default
};
struct
SelectEntry
{
struct
Code
base
;
struct
Code
*
expr
;
SelectEntry
*
fallback
;
int
fallbackidx
;
// save pattern temporarily before SelectEntry child is tried
Thunk
*
saved_pattern
;
struct
SelectCaseEntry
cases
[];
union
{
struct
SelectLitCaseEntry
cases
[];
struct
Code
*
bodies
[];
};
};
struct
IfEntry
{
...
...
interpreter/desc.h
View file @
b5b61142
...
...
@@ -26,6 +26,10 @@ struct SliceEntry {
struct
ADTEntry
{
struct
Desc
base
;
int
strictness
;
unsigned
int
nrConses
;
// number of constructors in the type
unsigned
int
idx
;
// constructor index
char
name
[];
};
...
...
interpreter/main.c
View file @
b5b61142
...
...
@@ -29,7 +29,7 @@ int main ( int argc, char *argv[] )
init_desc
();
init_prim
();
char
*
input
=
"..
\\
tests
\\
Eval
.bsapl"
;
char
*
input
=
"..
\\
tests
\\
queens
.bsapl"
;
if
(
argc
==
2
)
{
...
...
@@ -77,7 +77,7 @@ int main ( int argc, char *argv[] )
// TODO: put it into a special "expression" space, instead of "code"
char
*
exprstream
=
"A0 F4 main"
;
Code
*
expr
=
parseTerm
(
&
exprstream
,
NULL
);
Code
*
expr
=
parseTerm
(
&
exprstream
);
#ifdef BENCHMARK
struct
timeval
t1
,
t2
;
...
...
interpreter/parse.c
View file @
b5b61142
...
...
@@ -165,6 +165,8 @@ int parseDef1(char** ptr) {
entry
->
base
.
thunk_size
=
thunk_size_f
(
arity
);
entry
->
base
.
unboxable
=
false
;
entry
->
base
.
hnf
=
true
;
entry
->
idx
=
i
;
entry
->
nrConses
=
conNum
;
// now the name can be copied into the ADTEntry
memcpy
(
entry
->
name
,
namePtr
,
nameLength
);
...
...
@@ -302,7 +304,7 @@ VarEntry* parseVar(char **ptr, VarEntry* target) {
return
entry
;
}
Code
*
parseTerm
(
char
**
ptr
,
SelectCaseEntry
*
fallback
);
Code
*
parseTerm
(
char
**
ptr
);
/*
* It is very messy, because it handles 3 cases:
...
...
@@ -344,7 +346,7 @@ Code* parseApp(char **ptr, bool dynamic) {
entry
=
(
AppEntry
*
)
alloc_code
(
sizeof
(
AppEntry
)
+
sizeof
(
void
*
)
*
nrArgs
);
for
(
int
i
=
0
;
i
<
nrArgs
;
i
++
)
{
entry
->
args
[
i
]
=
parseTerm
(
ptr
,
NULL
);
entry
->
args
[
i
]
=
parseTerm
(
ptr
);
if
(
entry
->
args
[
i
]
==
0
)
return
0
;
}
...
...
@@ -434,51 +436,80 @@ Code* parseApp(char **ptr, bool dynamic) {
return
(
Code
*
)
entry
;
}
SelectEntry
*
parseSelect
(
char
**
ptr
,
SelectCaseEntry
*
fallback
)
{
Code
*
expr
=
parseTerm
(
ptr
,
NULL
);
SelectEntry
*
parseSelect
(
char
**
ptr
)
{
Code
*
expr
=
parseTerm
(
ptr
);
int
nrCases
;
if
(
!
parseInt
(
ptr
,
&
nrCases
))
return
0
;
struct
SelectEntry
*
entry
=
(
SelectEntry
*
)
alloc_code
(
sizeof
(
SelectEntry
)
+
sizeof
(
SelectCaseEntry
)
*
nrCases
);
entry
->
base
.
type
=
CT_SELECT
;
entry
->
base
.
nr_cases
=
nrCases
;
entry
->
expr
=
expr
;
for
(
int
i
=
0
;
i
<
nrCases
;
i
++
)
{
char
type
=
*
(
*
ptr
)
++
;
switch
(
type
)
{
case
'C'
:
entry
->
cases
[
i
].
type
=
SC_CONS
;
entry
->
cases
[
i
].
cons
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
break
;
case
'L'
:
entry
->
cases
[
i
].
type
=
SC_LIT
;
entry
->
cases
[
i
].
lit
=
parseLit
(
ptr
);
break
;
case
'D'
:
entry
->
cases
[
i
].
type
=
SC_DEFAULT
;
break
;
default:
return
0
;
// unknown case
}
struct
SelectEntry
*
entry
=
NULL
;
char
type
=
**
ptr
;
entry
->
cases
[
i
].
parent
=
(
Code
*
)
entry
;
entry
->
cases
[
i
].
body
=
(
Code
*
)
parseTerm
(
ptr
,
&
entry
->
cases
[
i
]);
bool
isDefault
=
false
;
Code
*
defaultBody
=
NULL
;
// Default is always the first
if
(
type
==
'D'
)
{
isDefault
=
true
;
(
*
ptr
)
++
;
defaultBody
=
(
Code
*
)
parseTerm
(
ptr
);
type
=
**
ptr
;
}
if
(
fallback
!=
NULL
)
bool
isADT
=
type
==
'C'
;
if
(
isADT
)
{
SelectEntry
*
parent
=
(
SelectEntry
*
)
fallback
->
parent
;
entry
->
fallback
=
parent
;
entry
->
fallbackidx
=
(
fallback
-
parent
->
cases
)
+
1
;
(
*
ptr
)
++
;
ADTEntry
*
firstCase
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
Code
*
firstBody
=
(
Code
*
)
parseTerm
(
ptr
);
entry
=
(
SelectEntry
*
)
alloc_code
(
sizeof
(
SelectEntry
)
+
sizeof
(
Code
*
)
*
firstCase
->
nrConses
);
entry
->
base
.
type
=
CT_SELECT_ADT
;
entry
->
base
.
nr_cases
=
firstCase
->
nrConses
;
entry
->
expr
=
expr
;
// set the default case for all the entries
for
(
int
i
=
0
;
i
<
firstCase
->
nrConses
;
i
++
)
{
entry
->
bodies
[
i
]
=
defaultBody
;
}
if
(
isDefault
)
nrCases
--
;
nrCases
--
;
// firstCase
entry
->
bodies
[
firstCase
->
idx
]
=
firstBody
;
for
(
int
i
=
0
;
i
<
nrCases
;
i
++
)
{
(
*
ptr
)
++
;
// skip type
ADTEntry
*
nextCase
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
entry
->
bodies
[
nextCase
->
idx
]
=
(
Code
*
)
parseTerm
(
ptr
);
}
}
else
{
entry
->
fallback
=
NULL
;
entry
=
(
SelectEntry
*
)
alloc_code
(
sizeof
(
SelectEntry
)
+
sizeof
(
SelectLitCaseEntry
)
*
nrCases
);
entry
->
base
.
type
=
CT_SELECT_LIT
;
entry
->
base
.
nr_cases
=
nrCases
;
entry
->
expr
=
expr
;
if
(
isDefault
)
{
nrCases
--
;
entry
->
cases
[
nrCases
].
body
=
defaultBody
;
entry
->
cases
[
nrCases
].
lit
=
NULL
;
}
for
(
int
i
=
0
;
i
<
nrCases
;
i
++
)
{
(
*
ptr
)
++
;
// skip type
entry
->
cases
[
i
].
lit
=
parseLit
(
ptr
);
entry
->
cases
[
i
].
body
=
(
Code
*
)
parseTerm
(
ptr
);
}
}
set_create_thunk_fun
((
Code
*
)
entry
);
return
entry
;
}
...
...
@@ -486,15 +517,15 @@ SelectEntry* parseSelect(char **ptr, SelectCaseEntry* fallback) {
IfEntry
*
parseIf
(
char
**
ptr
)
{
struct
IfEntry
*
entry
=
(
IfEntry
*
)
alloc_code
(
sizeof
(
IfEntry
));
entry
->
base
.
type
=
CT_IF
;
entry
->
cond
=
parseTerm
(
ptr
,
NULL
);
entry
->
texpr
=
parseTerm
(
ptr
,
NULL
);
entry
->
fexpr
=
parseTerm
(
ptr
,
NULL
);
entry
->
cond
=
parseTerm
(
ptr
);
entry
->
texpr
=
parseTerm
(
ptr
);
entry
->
fexpr
=
parseTerm
(
ptr
);
set_create_thunk_fun
((
Code
*
)
entry
);
return
entry
;
}
Code
*
parseTerm
(
char
**
ptr
,
SelectCaseEntry
*
parent
)
{
Code
*
parseTerm
(
char
**
ptr
)
{
// 1. Type char
char
type
=
*
(
*
ptr
)
++
;
...
...
@@ -510,7 +541,7 @@ Code* parseTerm(char **ptr, SelectCaseEntry* parent) {
case
'D'
:
// Dynamic application
return
(
Code
*
)
parseApp
(
ptr
,
true
);
case
'S'
:
// Select
return
(
Code
*
)
parseSelect
(
ptr
,
parent
);
return
(
Code
*
)
parseSelect
(
ptr
);
case
'I'
:
// If
return
(
Code
*
)
parseIf
(
ptr
);
default:
...
...
@@ -537,7 +568,7 @@ int parseDef2(char** ptr) {
*
ptr
=
entry
->
parseCont
;
// parse body
entry
->
body
=
parseTerm
(
ptr
,
NULL
);
entry
->
body
=
parseTerm
(
ptr
);
break
;
}
...
...
@@ -550,7 +581,7 @@ int parseDef2(char** ptr) {
*
ptr
=
entry
->
parseCont
;
// parse body
entry
->
body
=
parseTerm
(
ptr
,
NULL
);
entry
->
body
=
parseTerm
(
ptr
);
break
;
}
...
...
interpreter/parse.h
View file @
b5b61142
...
...
@@ -7,6 +7,6 @@
int
parse
(
char
**
ptr
,
int
length
);
Code
*
parseTerm
(
char
**
ptr
,
SelectCaseEntry
*
fallback
);
Code
*
parseTerm
(
char
**
ptr
);
#endif // __PARSE_H
\ No newline at end of file
tests/primes.bsapl
0 → 100644
View file @
b5b61142
112 F9 primes.el2 3 SVS0 2 DSVS1 1 C11 primes.ConsT2 A2 VS0 LI1 F3 subVL3 F9 primes.elLI0 SVS1 1 C11 primes.ConsVL2 161 F11 primes.filt2 2 SVS1 2 C12 primes.EmptyA0 F12 primes.EmptyC11 primes.ConsID1 VL2 L0 A2 VL2 A2 VL0 VL3 F11 primes.filtF11 primes.ConsT2 VL0 VL3 F11 primes.filt49 F10 primes.nmz2 3 A2 A2 VS1 VS0 F3 modLI0 F4 neqI116 F8 primes.s1 1 SVS0 1 C11 primes.ConsA2 VL1 A1 A2 A1 VL1 F10 primes.nmzVL2 F11 primes.filtF8 primes.sF11 primes.Cons40 A2 11 primes.Cons2 0 12 primes.Empty0 0 70 F9 primes.fr1 0 A2 VL0 A1 A2 VL0 LI1 F3 addF9 primes.frF11 primes.Cons49 F9 primes.pr0 0 A1 A1 LI2 F9 primes.frF8 primes.s57 F12 primes.Start0 0 A2 LI5000 A0 F9 primes.prF9 primes.el30 F4 main0 0 A0 F12 primes.Start
\ No newline at end of file
tests/
postponed/
primes.sapl
→
tests/primes.sapl
View file @
b5b61142
File moved
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