Commit e72c4e2f authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

handle static oversaturated applications

parent 160557ab
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
......@@ -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]);
......
......@@ -117,3 +117,4 @@ struct FunEntry* __ARRAY__;
struct FunEntry* __FORWARD_PTR__;
char* appNames[] = {"App1", "App2", "App3", "App4", "App5"};
\ No newline at end of file
......@@ -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
......@@ -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 uses, remove?
unsigned int unboxable : 1; // TODO: not used, remove?
unsigned int hnf : 1;
};
......
......@@ -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(nrArgsToParse == 1)
{
entry->base.type = CT_APP_FUN1;
}
else if(nrArgs == 2)
else if(nrArgsToParse == 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 = nrArgsToParse;
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) {
......
......@@ -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 <++ sList0 (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" <++ sList (sTerm ctx) [] <++ sVar ctx var
_ = a <++ "A" <++ sNum 0 <++ sVar ctx var <++ sList0 (sTerm ctx) []
where
varName = unpackVar var
......
[9]
\ No newline at end of file
main = ostest.Start
ostest.Start::I = ostest.halfadd 4 5
ostest.halfadd::I a::I = addI a
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment