mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-26 21:23:53 +03:00
a76a1322eb
Written by Volkmar Frinken (@vfrinken). This is intended as a lightweight (i.e. minimal dependencies) code generator that can be ported to multiple platforms, especially those with memory constraints. It shouldn't be expected to be anywhere near as fast as the Scheme back end, for lots of reasons. The main goal is portability.
115 lines
2.9 KiB
C
115 lines
2.9 KiB
C
#include "runtime.h"
|
|
|
|
void push_Arglist(Value_Arglist *arglist, Value *arg)
|
|
{
|
|
if (arglist->filled >= arglist->total)
|
|
{
|
|
fprintf(stderr, "unable to add more arguments to arglist\n");
|
|
exit(1);
|
|
}
|
|
|
|
arglist->args[arglist->filled] = newReference(arg);
|
|
arglist->filled++;
|
|
}
|
|
|
|
Value *apply_closure(Value *_clos, Value *arg)
|
|
{
|
|
// create a new arg list
|
|
Value_Arglist *oldArgs = ((Value_Closure *)_clos)->arglist;
|
|
Value_Arglist *newArgs = newArglist(0, oldArgs->total);
|
|
newArgs->filled = oldArgs->filled + 1;
|
|
// add argument to new arglist
|
|
for (int i = 0; i < oldArgs->filled; i++)
|
|
{
|
|
newArgs->args[i] = newReference(oldArgs->args[i]);
|
|
}
|
|
newArgs->args[oldArgs->filled] = newReference(arg);
|
|
|
|
Value_Closure *clos = (Value_Closure *)_clos;
|
|
|
|
// check if enough arguments exist
|
|
if (newArgs->filled >= newArgs->total)
|
|
{
|
|
fun_ptr_t f = clos->f;
|
|
while (1)
|
|
{
|
|
Value *retVal = f(newArgs);
|
|
removeReference((Value *)newArgs);
|
|
if (!retVal || retVal->header.tag != COMPLETE_CLOSURE_TAG)
|
|
{
|
|
return retVal;
|
|
}
|
|
f = ((Value_Closure *)retVal)->f;
|
|
newArgs = ((Value_Closure *)retVal)->arglist;
|
|
newArgs = (Value_Arglist *)newReference((Value *)newArgs);
|
|
removeReference(retVal);
|
|
}
|
|
}
|
|
|
|
return (Value *)makeClosureFromArglist(clos->f, newArgs);
|
|
}
|
|
|
|
Value *tailcall_apply_closure(Value *_clos, Value *arg)
|
|
{
|
|
// create a new arg list
|
|
Value_Arglist *oldArgs = ((Value_Closure *)_clos)->arglist;
|
|
Value_Arglist *newArgs = newArglist(0, oldArgs->total);
|
|
newArgs->filled = oldArgs->filled + 1;
|
|
// add argument to new arglist
|
|
for (int i = 0; i < oldArgs->filled; i++)
|
|
{
|
|
newArgs->args[i] = newReference(oldArgs->args[i]);
|
|
}
|
|
newArgs->args[oldArgs->filled] = newReference(arg);
|
|
|
|
Value_Closure *clos = (Value_Closure *)_clos;
|
|
|
|
// check if enough arguments exist
|
|
if (newArgs->filled >= newArgs->total)
|
|
return (Value *)makeClosureFromArglist(clos->f, newArgs);
|
|
|
|
return (Value *)makeClosureFromArglist(clos->f, newArgs);
|
|
}
|
|
|
|
int extractInt(Value *v)
|
|
{
|
|
if (v->header.tag == INT64_TAG)
|
|
{
|
|
return (int)((Value_Int64 *)v)->i64;
|
|
}
|
|
|
|
if (v->header.tag == INT32_TAG)
|
|
{
|
|
return ((Value_Int32 *)v)->i32;
|
|
}
|
|
|
|
if (v->header.tag == DOUBLE_TAG)
|
|
{
|
|
return (int)((Value_Double *)v)->d;
|
|
}
|
|
|
|
return -1;
|
|
}
|
|
|
|
Value *trampoline(Value *closure)
|
|
{
|
|
fun_ptr_t f = ((Value_Closure *)closure)->f;
|
|
Value_Arglist *_arglist = ((Value_Closure *)closure)->arglist;
|
|
Value_Arglist *arglist = (Value_Arglist *)newReference((Value *)_arglist);
|
|
removeReference(closure);
|
|
while (1)
|
|
{
|
|
Value *retVal = f(arglist);
|
|
removeReference((Value *)arglist);
|
|
if (!retVal || retVal->header.tag != COMPLETE_CLOSURE_TAG)
|
|
{
|
|
return retVal;
|
|
}
|
|
f = ((Value_Closure *)retVal)->f;
|
|
arglist = ((Value_Closure *)retVal)->arglist;
|
|
arglist = (Value_Arglist *)newReference((Value *)arglist);
|
|
removeReference(retVal);
|
|
}
|
|
return NULL;
|
|
}
|