upd

jk.c

@@ -9,6 +9,7 @@
 #include <pcre.h>
 #include <setjmp.h>
 #include <stdbool.h>
+#include <stddef.h>
 #include <stdint.h>
 #include <stdio.h>
 #include <stdlib.h>
@@ -19,6 +20,8 @@
 
 jmp_buf interactive_checkpoint;
 bool is_interactive;
+size_t max_rec_depth = 1000;
+size_t rec_depth = 0;
 
 void *malloc_checked(size_t size) {
   void *p;
@@ -248,26 +251,32 @@ void lexer_push_token(lexer_t *lexer, enum token_tag_t tag, char *text) {
 
 list_t *guards;
 
-jmp_buf *guard() {
-  jmp_buf *lb = malloc_checked_atomic(sizeof(jmp_buf));
-
-  list_push(guards, lb);
+typedef struct {
+  jmp_buf lb;
 
-  return lb;
-}
+  size_t rec_depth;
+} guard_t;
 
-jmp_buf *guarding() { return list_index(guards, -1); }
+guard_t *guard() {
+  guard_t *g = malloc_checked_atomic(sizeof(guard_t));
 
-void unguard() {
-  jmp_buf *lb = list_pop(guards);
+  g->rec_depth = rec_depth;
+  list_push(guards, g);
 
-  GC_FREE(lb);
+  return g;
 }
 
+guard_t *guarding() { return list_index(guards, -1); }
+
+void unguard() { GC_FREE(list_pop(guards)); }
+
 void fatal(char *s) {
-  jmp_buf *lb;
-  if ((lb = guarding()))
-    longjmp(*lb, 1);
+  guard_t *g = guarding();
+  if (g) {
+    rec_depth = g->rec_depth;
+
+    longjmp(g->lb, 1);
+  }
 
   fprintf(stderr, "|%s error\n", s);
 
@@ -1221,6 +1230,11 @@ value_t *each_rank(interpreter_t *state, verb_t *f, value_t *x, unsigned int d,
   if (!f->monad)
     return state->udf;
 
+  if (rec_depth >= max_rec_depth)
+    abort();
+
+  rec_depth++;
+
   if (d >= rm || x->tag != ARRAY) {
     if (f->mark)
       list_push(state->selfrefs, f);
@@ -1230,17 +1244,24 @@ value_t *each_rank(interpreter_t *state, verb_t *f, value_t *x, unsigned int d,
     if (f->mark)
       list_pop(state->selfrefs);
 
+    rec_depth--;
+
     return r;
   }
 
   list_t *t = x->val.array;
-  if (!t->data)
+  if (!t->data) {
+    rec_depth--;
+
     return x;
+  }
 
   list_t *l = list_newk(t->length);
   for (size_t i = 0; i < t->length; i++)
     l->data[i] = each_rank(state, f, t->data[i], d + 1, rm);
 
+  rec_depth--;
+
   return value_new_array(l);
 }
 
@@ -1260,6 +1281,11 @@ value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
   if (!f->dyad)
     return state->udf;
 
+  if (rec_depth >= max_rec_depth)
+    abort();
+
+  rec_depth++;
+
   if (dl >= rl && dr >= rr) {
     if (f->mark)
       list_push(state->selfrefs, f);
@@ -1269,6 +1295,8 @@ value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
     if (f->mark)
       list_pop(state->selfrefs);
 
+    rec_depth--;
+
     return r;
   }
 
@@ -1276,8 +1304,11 @@ value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
     list_t *tx = x->val.array;
     list_t *ty = y->val.array;
 
-    if (!tx->data || !ty->data)
+    if (!tx->data || !ty->data) {
+      rec_depth--;
+
       return !tx->data ? x : y;
+    }
 
     list_t *t = list_newk(ty->length < tx->length ? ty->length : tx->length);
     for (size_t i = 0; i < tx->length; i++) {
@@ -1288,12 +1319,17 @@ value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
           together(state, f, tx->data[i], ty->data[i], dl + 1, dr + 1, rl, rr);
     }
 
+    rec_depth--;
+
     return value_new_array(t);
   } else if ((x->tag != ARRAY || dl >= rl) && y->tag == ARRAY && dr < rr) {
     list_t *ty = y->val.array;
 
-    if (!ty->data)
+    if (!ty->data) {
+      rec_depth--;
+
       return y;
+    }
 
     list_t *t = list_newk(ty->length);
     for (size_t i = 0; i < ty->length; i++)
@@ -1303,13 +1339,18 @@ value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
   } else if ((y->tag != ARRAY || dr >= rr) && x->tag == ARRAY && dl < rl) {
     list_t *tx = x->val.array;
 
-    if (!tx->data)
+    if (!tx->data) {
+      rec_depth--;
+
       return x;
+    }
 
     list_t *t = list_newk(tx->length);
     for (size_t i = 0; i < tx->length; i++)
       t->data[i] = together(state, f, tx->data[i], y, dl + 1, dr, rl, rr);
 
+    rec_depth--;
+
     return value_new_array(t);
   }
 
@@ -1321,6 +1362,8 @@ value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
   if (f->mark)
     list_pop(state->selfrefs);
 
+  rec_depth--;
+
   return r;
 }
 
@@ -4896,7 +4939,7 @@ value_t *verb_outof(interpreter_t *state, verb_t *self, value_t *x,
     if (b == 0)
       return NUMS[0];
 
-    return value_new_number(factorial(b) /
+    return value_new_number((double)factorial(b) /
                             (factorial(a) * (a >= b ? 1 : factorial(b - a))));
   }
 
@@ -4922,9 +4965,9 @@ value_t *interpreter_run(interpreter_t *state, char *program);
 value_t *verb_eval(interpreter_t *state, verb_t *self, value_t *x) {
   char *s = value_str(x);
 
-  jmp_buf *lb = guard();
+  guard_t *g = guard();
 
-  if (setjmp(*lb)) {
+  if (setjmp(g->lb)) {
     unguard();
 
     GC_FREE(s);
@@ -5372,6 +5415,20 @@ value_t *verb_tackleft(interpreter_t *state, verb_t *self, value_t *x,
   return value_new_array(r);
 }
 
+value_t *verb_setrecdepth(interpreter_t *state, verb_t *self, value_t *x) {
+  if (x->tag != NUMBER)
+    return state->udf;
+
+  size_t ov = max_rec_depth;
+  size_t v = (size_t)fabs(x->val.number);
+  if (v < 1)
+    v = 1;
+
+  max_rec_depth = v;
+
+  return value_new_number(ov);
+}
+
 value_t *verb_tackright(interpreter_t *state, verb_t *self, value_t *x,
                         value_t *y) {
   if (y->tag != ARRAY)
@@ -5674,7 +5731,7 @@ verb_t VERBS[] = {DEFVERB(":", 0, 0, 0, const, bind),
                   DEFVERBD("e", 0, 0, 0, eval, udf2),
                   DEFVERBD("i", 0, 0, 0, import, foreign),
                   DEFVERBD("L", 0, 0, 0, lines, tackleft),
-                  DEFVERBD("R", 0, 0, 0, udf1, tackright),
+                  DEFVERBD("R", X, 0, 0, setrecdepth, tackright),
                   DEFVERBD("v", 0, 0, 0, value, udf2),
                   DEFVERBD("x", 0, 0, 0, show, rematch),
                   DEFVERBD("X", 0, 0, 0, udf1, extract)};