Idris2/support/refc/runtime.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 == INTEGER_TAG)
  {
    return (int)mpz_get_si(((Value_Integer *)v)->i);
  }

  if (v->header.tag == INT8_TAG)
  {
    return (int)((Value_Int8 *)v)->i8;
  }

  if (v->header.tag == INT16_TAG)
  {
    return (int)((Value_Int16 *)v)->i16;
  }

  if (v->header.tag == INT32_TAG)
  {
    return (int)((Value_Int32 *)v)->i32;
  }

  if (v->header.tag == INT64_TAG)
  {
    return (int)((Value_Int64 *)v)->i64;
  }

  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;
}