From 49cf2e67feedab2f5eda9575d7b5cc10cb74d385 Mon Sep 17 00:00:00 2001
From: Stephen Dolan <mu@netsoc.tcd.ie>
Date: Mon, 17 Sep 2012 22:32:06 +0100
Subject: [PATCH] Recursive functions + bugfix for stack reallocation.

---
 c/compile.c        |  7 +++++++
 c/compile.h        |  1 +
 c/forkable_stack.h | 24 ++++++++++++++++--------
 c/parser.y         |  4 ++--
 c/testdata         |  6 ++++++
 5 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/c/compile.c b/c/compile.c
index 023acb95..952aff3b 100644
--- a/c/compile.c
+++ b/c/compile.c
@@ -164,6 +164,13 @@ block gen_op_block_defn(opcode op, const char* name, block block) {
   return inst_block(i);
 }
 
+static void block_bind_subblock(block binder, block body, int bindflags);
+block gen_op_block_defn_rec(opcode op, const char* name, block blk) {
+  block b = gen_op_block_defn(op, name, blk);
+  block_bind_subblock(b, b, OP_IS_CALL_PSEUDO | OP_HAS_BINDING);
+  return b;
+}
+
 block gen_op_block_unbound(opcode op, const char* name) {
   assert(opcode_describe(op)->flags & OP_IS_CALL_PSEUDO);
   inst* i = inst_new(op);
diff --git a/c/compile.h b/c/compile.h
index 411654fe..ce27b4b8 100644
--- a/c/compile.h
+++ b/c/compile.h
@@ -23,6 +23,7 @@ block gen_op_target(opcode op, block target);
 block gen_op_var_unbound(opcode op, const char* name);
 block gen_op_var_bound(opcode op, block binder);
 block gen_op_block_defn(opcode op, const char* name, block block);
+block gen_op_block_defn_rec(opcode op, const char* name, block block);
 block gen_op_block_unbound(opcode op, const char* name);
 block gen_op_call(opcode op, block arglist);
 block gen_op_symbol(opcode op, const char* name);
diff --git a/c/forkable_stack.h b/c/forkable_stack.h
index d485d227..5bfad8a9 100644
--- a/c/forkable_stack.h
+++ b/c/forkable_stack.h
@@ -6,7 +6,9 @@
 #include <string.h>
 
 struct forkable_stack_header {
-  int next;
+  /* distance in bytes between this header and the header
+     of the next object on the stack */
+  int next_delta;
 };
 
 #define FORKABLE_STACK_HEADER struct forkable_stack_header fk_header_
@@ -54,11 +56,12 @@ static void forkable_stack_free(struct forkable_stack* s) {
 }
 
 static void* forkable_stack_push(struct forkable_stack* s, size_t sz_size) {
+  assert(sz_size > 0 && sz_size % sizeof(struct forkable_stack_header) == 0);
   int size = (int)sz_size;
   forkable_stack_check(s);
   int curr = s->pos < s->savedlimit ? s->pos : s->savedlimit;
   if (curr - size < 0) {
-    assert(0);
+    //assert(0);
     int oldlen = s->length;
     s->length = (size + oldlen + 1024) * 2;
     s->stk = realloc(s->stk, s->length);
@@ -68,9 +71,11 @@ static void* forkable_stack_push(struct forkable_stack* s, size_t sz_size) {
     s->savedlimit += shift;
     curr += shift;
   }
-  void* ret = (void*)(s->stk + curr - size);
-  ((struct forkable_stack_header*)ret)->next = s->pos;
-  s->pos = curr - size;
+  int newpos = curr - size;
+  assert(newpos < s->pos);
+  void* ret = (void*)(s->stk + newpos);
+  ((struct forkable_stack_header*)ret)->next_delta = s->pos - newpos;
+  s->pos = newpos;
   forkable_stack_check(s);
   return ret;
 }
@@ -84,8 +89,11 @@ static void* forkable_stack_peek(struct forkable_stack* s) {
 static void* forkable_stack_peek_next(struct forkable_stack* s, void* top) {
   forkable_stack_check(s);
   struct forkable_stack_header* elem = top;
-  if (elem->next < s->length) {
-    return (void*)(s->stk + elem->next);
+  int elempos = (char*)top - s->stk;
+  assert(elempos >= 0 && elempos < s->length);
+  assert(elempos + elem->next_delta <= s->length);
+  if (elempos + elem->next_delta < s->length) {
+    return (void*)(s->stk + elempos + elem->next_delta);
   } else {
     return 0;
   }
@@ -100,7 +108,7 @@ static int forkable_stack_pop_will_free(struct forkable_stack* s) {
 static void forkable_stack_pop(struct forkable_stack* s) {
   forkable_stack_check(s);
   struct forkable_stack_header* elem = forkable_stack_peek(s);
-  s->pos = elem->next;
+  s->pos += elem->next_delta;
 }
 
 
diff --git a/c/parser.y b/c/parser.y
index 822a3385..4492d185 100644
--- a/c/parser.y
+++ b/c/parser.y
@@ -165,14 +165,14 @@ program: Exp { *answer = $1; }
 Exp:
 "def" IDENT ':' Exp ';' Exp {
   block body = block_join($4, gen_op_simple(RET));
-  $$ = block_bind(gen_op_block_defn(CLOSURE_CREATE, jv_string_value($2), body), 
+  $$ = block_bind(gen_op_block_defn_rec(CLOSURE_CREATE, jv_string_value($2), body), 
                   $6, OP_IS_CALL_PSEUDO);
   jv_free($2);
 } |
 
 "def" IDENT '(' IDENT ')' ':' Exp ';' Exp {
   block body = block_bind(gen_op_block_unbound(CLOSURE_PARAM, jv_string_value($4)), block_join($7, gen_op_simple(RET)), OP_IS_CALL_PSEUDO);
-  $$ = block_bind(gen_op_block_defn(CLOSURE_CREATE, jv_string_value($2), body), $9, OP_IS_CALL_PSEUDO);
+  $$ = block_bind(gen_op_block_defn_rec(CLOSURE_CREATE, jv_string_value($2), body), $9, OP_IS_CALL_PSEUDO);
   jv_free($2);
   jv_free($4);
 } |
diff --git a/c/testdata b/c/testdata
index 72367bbf..7357ccb2 100644
--- a/c/testdata
+++ b/c/testdata
@@ -262,6 +262,12 @@ def id(x):x; 2000 as $x | def f(x):1 as $x | id([$x, x, x]); def g(x): 100 as $x
 999999999
 [[110.0, 130.0], [210.0, 130.0], [110.0, 230.0], [210.0, 230.0], [120.0, 160.0], [220.0, 160.0], [120.0, 260.0], [220.0, 260.0]]
 
+# test recursion
+def fac: if . == 1 then 1 else . * (. - 1 | fac) end; [.[] | fac]
+[1,2,3,4]
+[1,2,6,24]
+
+
 #
 # Assignment
 #