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
e72c4e2f
Commit
e72c4e2f
authored
Jan 18, 2016
by
Laszlo Domoszlai
Browse files
handle static oversaturated applications
parent
160557ab
Changes
9
Hide whitespace changes
Inline
Side-by-side
interpreter/builtin.sapl
View file @
e72c4e2f
App1 f a1 = f a1
App2 f a1 a2 = f a1 a2
App3 f a1 a2 a3 = f a1 a2 a3
App4 f a1 a2 a3 a4 = f a1 a2 a3 a4
App5 f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5
\ No newline at end of file
App1 !f a1 = f a1
App2 !f a1 a2 = f a1 a2
App3 !f a1 a2 a3 = f a1 a2 a3
App4 !f a1 a2 a3 a4 = f a1 a2 a3 a4
App5 !f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5
\ No newline at end of file
interpreter/code.c
View file @
e72c4e2f
...
...
@@ -256,7 +256,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case
CT_APP_FUN2
:
{
Desc
*
slice
=
((
AppEntry
*
)
expr
)
->
f
;
int
argmask
=
1
;
arg_from_code
(
slice
,
((
AppEntry
*
)
expr
)
->
args
[
0
]);
...
...
interpreter/desc.c
View file @
e72c4e2f
...
...
@@ -117,3 +117,4 @@ struct FunEntry* __ARRAY__;
struct
FunEntry
*
__FORWARD_PTR__
;
char
*
appNames
[]
=
{
"App1"
,
"App2"
,
"App3"
,
"App4"
,
"App5"
};
\ No newline at end of file
interpreter/desc.h
View file @
e72c4e2f
...
...
@@ -81,4 +81,7 @@ extern struct FunEntry* __ARRAY__;
extern
struct
FunEntry
*
__FORWARD_PTR__
;
// Function names of the App built in functions, per arity
extern
char
*
appNames
[];
#endif // __DESC_H
\ No newline at end of file
interpreter/desc_base.h
View file @
e72c4e2f
...
...
@@ -11,7 +11,7 @@ struct Desc {
FunType
type
:
4
;
unsigned
int
arity
:
8
;
// LIMITATION: maximum 32 arguments
unsigned
int
thunk_size
:
10
;
// It gives false result for strings and arrays
unsigned
int
unboxable
:
1
;
// TODO: not use
s
, remove?
unsigned
int
unboxable
:
1
;
// TODO: not use
d
, remove?
unsigned
int
hnf
:
1
;
};
...
...
interpreter/parse.c
View file @
e72c4e2f
...
...
@@ -7,6 +7,7 @@
#include
"mem.h"
#include
"code.h"
#include
"desc.h"
#include
"debug.h"
int
parseInt
(
char
**
ptr
,
int
*
result
)
{
char
*
end
;
...
...
@@ -328,16 +329,27 @@ Code* parseSelectBody(char **ptr, Code* fallback, int fallback_nrargs);
* 4. Other static cases
*/
Code
*
parseApp
(
char
**
ptr
,
bool
dynamic
,
bool
tr
)
{
int
nrArgs
;
if
(
!
parseInt
(
ptr
,
&
nrArgs
))
return
0
;
Desc
*
desc
=
NULL
;
bool
overSaturated
=
false
;
if
(
!
dynamic
)
{
(
*
ptr
)
++
;
// Skip 'F' for the static var
desc
=
parseFunName
(
ptr
);
// can fail
overSaturated
=
desc
->
arity
<
nrArgs
;
}
int
nrArgsToParse
=
overSaturated
?
desc
->
arity
:
nrArgs
;
struct
AppEntry
*
entry
=
NULL
;
if
(
!
dynamic
&&
nrArgs
==
0
)
{
(
*
ptr
)
++
;
// Skip 'F' for the static var
Desc
*
desc
=
parseFunName
(
ptr
);
// can fail
if
(
desc
!=
NULL
)
desc
=
get_slice
(
desc
,
nrArgs
);
if
(
desc
!=
NULL
&&
(
desc
->
type
==
FT_ADT
||
desc
->
type
==
FT_SLICE
))
...
...
@@ -358,24 +370,22 @@ Code* parseApp(char **ptr, bool dynamic, bool tr) {
}
else
{
entry
=
(
AppEntry
*
)
alloc_code
(
sizeof
(
AppEntry
)
+
sizeof
(
void
*
)
*
nrArgs
);
for
(
int
i
=
0
;
i
<
nrArgs
;
i
++
)
{
entry
->
args
[
i
]
=
parseTerm
(
ptr
);
if
(
entry
->
args
[
i
]
==
0
)
return
0
;
}
entry
=
(
AppEntry
*
)
alloc_code
(
sizeof
(
AppEntry
)
+
sizeof
(
void
*
)
*
nrArgsToParse
);
if
(
dynamic
)
{
parseVar
(
ptr
,
&
entry
->
var
);
entry
->
base
.
type
=
CT_APP_DYN
;
}
else
for
(
int
i
=
0
;
i
<
nrArgsToParse
;
i
++
)
{
entry
->
args
[
i
]
=
parseTerm
(
ptr
);
if
(
entry
->
args
[
i
]
==
0
)
return
0
;
}
if
(
!
dynamic
)
{
(
*
ptr
)
++
;
// Skip 'F' for the static var
Desc
*
desc
=
parseFunName
(
ptr
);
// can fail
if
(
desc
!=
NULL
)
desc
=
get_slice
(
desc
,
nrArgs
);
if
(
desc
!=
NULL
)
desc
=
get_slice
(
desc
,
nrArgsToParse
);
entry
->
f
=
desc
;
if
(
desc
->
type
==
FT_PRIM1
)
...
...
@@ -439,11 +449,11 @@ Code* parseApp(char **ptr, bool dynamic, bool tr) {
}
else
if
(
desc
->
type
==
FT_FUN
&&
!
tr
)
{
if
(
nrArgs
==
1
)
if
(
nrArgs
ToParse
==
1
)
{
entry
->
base
.
type
=
CT_APP_FUN1
;
}
else
if
(
nrArgs
==
2
)
else
if
(
nrArgs
ToParse
==
2
)
{
entry
->
base
.
type
=
CT_APP_FUN2
;
}
...
...
@@ -460,12 +470,39 @@ Code* parseApp(char **ptr, bool dynamic, bool tr) {
{
entry
->
base
.
type
=
CT_APP_THUNK
;
}
}
}
}
entry
->
base
.
nr_args
=
nrArgs
;
entry
->
base
.
nr_args
=
nrArgs
ToParse
;
set_create_thunk_fun
((
Code
*
)
entry
);
return
(
Code
*
)
entry
;
// Create a wrapping Appx if necessary
if
(
overSaturated
)
{
int
appArity
=
nrArgs
-
desc
->
arity
;
assert
(
appArity
<=
5
);
struct
AppEntry
*
appEntry
=
(
AppEntry
*
)
alloc_code
(
sizeof
(
AppEntry
)
+
sizeof
(
void
*
)
*
(
appArity
+
1
));
appEntry
->
f
=
(
Desc
*
)
find_desc
(
appNames
[
appArity
-
1
]);
appEntry
->
base
.
type
=
CT_APP_FUN
;
appEntry
->
base
.
nr_args
=
appArity
+
1
;
set_create_thunk_fun
((
Code
*
)
appEntry
);
appEntry
->
args
[
0
]
=
(
Code
*
)
entry
;
for
(
int
i
=
1
;
i
<=
appArity
;
i
++
)
{
appEntry
->
args
[
i
]
=
parseTerm
(
ptr
);
if
(
appEntry
->
args
[
i
]
==
0
)
return
0
;
}
return
(
Code
*
)
appEntry
;
}
else
{
return
(
Code
*
)
entry
;
}
}
SelectEntry
*
parseSelect
(
char
**
ptr
,
Code
*
fallback
,
int
fallback_nrargs
)
{
...
...
precompiler/precompiler.icl
View file @
e72c4e2f
...
...
@@ -93,7 +93,7 @@ sTerm ctx t a = sTermS ctx (simplify t) a
where
sTermS
ctx
(
SLit
lit
)
a
=
a
<++
"L"
<++
lit
sTermS
ctx
(
SVar
var
)
a
=
a
<++
sVarApp
ctx
var
sTermS
ctx
(
SApplication
var
terms
)
a
=
a
<++
appType
ctx
var
<++
sList
(
sTerm
{
ctx
&
inspine
=
False
})
terms
<++
sVar
ctx
var
sTermS
ctx
(
SApplication
var
terms
)
a
=
a
<++
appType
ctx
var
<++
sNum
(
length
terms
)
<++
sVar
ctx
var
<++
sList
0
(
sTerm
{
ctx
&
inspine
=
False
})
terms
sTermS
ctx
(
SSelect
expr
cs
)
a
=
a
<++
"S"
<++
sTerm
{
ctx
&
inspine
=
False
}
expr
<++
sList
(
sSelectCase
ctx
)
(
sortBy
selectCaseOrder
cs
)
sTermS
ctx
(
SIf
cond
texpr
fexpr
)
a
=
a
<++
"I"
<++
sTerm
{
ctx
&
inspine
=
False
}
cond
<++
sTerm
ctx
texpr
<++
sTerm
ctx
fexpr
sTermS
ctx
(
SLet
body
bindings
)
a
...
...
@@ -135,7 +135,7 @@ where
sVarApp
ctx
var
a
=
case
get
varName
ctx
.
vars
of
(
Just
l
=:(
Local
i
_))
=
a
<++
"V"
<++
sVarFlag
ctx
l
<++
sNum
i
_
=
a
<++
"A"
<++
s
List
(
sTerm
ctx
)
[]
<++
sVar
ctx
var
_
=
a
<++
"A"
<++
s
Num
0
<++
sVar
ctx
var
<++
sList0
(
sTerm
ctx
)
[]
where
varName
=
unpackVar
var
...
...
tests/static_os.exp
0 → 100644
View file @
e72c4e2f
[9]
\ No newline at end of file
tests/static_os.sapl
0 → 100644
View file @
e72c4e2f
main = ostest.Start
ostest.Start::I = ostest.halfadd 4 5
ostest.halfadd::I a::I = addI 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