~tim/lydia

bb1e285e606d10c4a0792662a2f29f3fc819ad08 — Tim Morgan 8 years ago 7306435
Add tail-call optimization for built-in if func.
5 files changed, 28 insertions(+), 7 deletions(-)

M src/closure.h
M src/funcs.c
M src/lib/logic.c
M src/lib/logic.h
M src/lidija.h
M src/closure.h => src/closure.h +1 -0
@@ 7,6 7,7 @@ typedef struct LClosure {
  struct LClosure *parent;
  bool cloneable;
  LNode *node;
  jmp_buf jmp;
} LClosure;

LClosure *l_closure_new(LNode *node);

M src/funcs.c => src/funcs.c +12 -1
@@ 26,7 26,18 @@ tail_loop:

  if(func->core.func.ptr != NULL) {
    // native C code
    value = func->core.func.ptr(args_val, cl);
    if(!setjmp(cl->jmp)) {
      value = func->core.func.ptr(args_val, cl);
    } else {
      // function called longjmp to initiate a tail call
      l_debug(L_DEBUG_CALL) printf("^^^ reached end of %s (longjmp tail call)\n", name);
      node = NULL;
      func = l_closure_get(cl, "--tail-call--");
      closure = cl;
      cl = func->core.func.closure;
      name = "";
      goto tail_loop;
    }
  } else {
    // Lidija code
    int exprc = func->core.func.exprc;

M src/lib/logic.c => src/lib/logic.c +13 -4
@@ 8,6 8,15 @@ bool l_to_bool(LValue *cond) {
          (cond->type == L_LIST_TYPE && cond->core.list->length == 0));
}

LValue *l_eval_if_expr(LValue *expr, LClosure *closure) {
  if(expr->type == L_FUNC_TYPE) {
    l_closure_set(closure, "--tail-call--", expr, true);
    longjmp(closure->jmp, 1);
  } else {
    return expr;
  }
}

// TODO put more asserts around this
LValue *l_func_if(LValue *args, LClosure *closure) {
  LValue *cond = l_list_get(args, 0);


@@ 19,12 28,12 @@ LValue *l_func_if(LValue *args, LClosure *closure) {
    for(i=0; i<len-1; i+=2) {
      inner_cond = (LValue*)vector_get(cond->core.list, i);
      if(l_to_bool(inner_cond)) {
        return l_eval_if_expr((LValue*)vector_get(cond->core.list, i+1));
        return l_eval_if_expr((LValue*)vector_get(cond->core.list, i+1), closure);
      }
    }
    // else
    if(len % 2 == 1) {
      return l_eval_if_expr((LValue*)vector_get(cond->core.list, len-1));
      return l_eval_if_expr((LValue*)vector_get(cond->core.list, len-1), closure);
    }
  } else {
    // single condition


@@ 33,9 42,9 @@ LValue *l_func_if(LValue *args, LClosure *closure) {
    if(true_expr == NULL) true_expr = l_value_new(L_NIL_TYPE, closure);
    if(false_expr == NULL) false_expr = l_value_new(L_NIL_TYPE, closure);
    if(l_to_bool(cond)) {
      return l_eval_if_expr(true_expr);
      return l_eval_if_expr(true_expr, closure);
    } else {
      return l_eval_if_expr(false_expr);
      return l_eval_if_expr(false_expr, closure);
    }
  }
  return l_value_new(L_NIL_TYPE, closure);

M src/lib/logic.h => src/lib/logic.h +1 -2
@@ 1,10 1,9 @@
#ifndef LOGIC_H
#define LOGIC_H

#define l_eval_if_expr(e) ((e)->type == L_FUNC_TYPE) ? l_eval_call_node(NULL, e, closure) : e

bool l_to_bool(LValue *cond);
bool l_eq(LValue *v1, LValue *v2);
LValue *l_eval_if_expr(LValue *expr, LClosure *closure);

LValue *l_func_if(LValue *args, LClosure *closure);
LValue *l_func_while(LValue *args, LClosure *closure);

M src/lidija.h => src/lidija.h +1 -0
@@ 2,6 2,7 @@
#include <stdlib.h>
#include <stdbool.h>
#include <stdio.h>
#include <setjmp.h>
#include <gmp.h>

#include <gc.h>