Add signal and fiber/can-resume?.

These additions, along with the change that user signals 0-4 cannot
be resumed, allow delimited continuation semantics, while repsecting
existing forms like `defer`, `with`, `with-vars`, etc.

src/boot/boot.janet

@@ -287,11 +287,12 @@
   ~(let (,;accum) ,;body))
 
 (defmacro defer
-  "Run form unconditionally after body, even if the body throws an error."
+  "Run form unconditionally after body, even if the body throws an error.
+  Will also run form if a user signal 0-4 is received."
   [form & body]
   (with-syms [f r]
     ~(do
-       (def ,f (,fiber/new (fn [] ,;body) :ie))
+       (def ,f (,fiber/new (fn [] ,;body) :ti))
        (def ,r (,resume ,f))
        ,form
        (if (= (,fiber/status ,f) :dead)
@@ -975,11 +976,10 @@
   (with-syms [ret f s]
   ~(do
      ,;saveold
-     (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ei))
+     (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
      (def ,ret (,resume ,f))
      ,;restoreold
-     (if (= (,fiber/status ,f) :error) (,propagate ,ret ,f))
+     (if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
-     ,ret)))
 
 (defn partial
   "Partial function application."
@@ -1855,8 +1855,7 @@
               (on-compile-error msg errf where))))
         (or guard :a)))
     (fiber/setenv f env)
-    (while (let [fs (fiber/status f)]
+    (while (fiber/can-resume? f)
-             (and (not= :dead fs) (not= :error fs)))
       (def res (resume f resumeval))
       (when good (when going (set resumeval (onstatus f res))))))
 

src/core/corelib.c

@@ -489,6 +489,26 @@ ret_false:
     return janet_wrap_false();
 }
 
+static Janet janet_core_signal(int32_t argc, Janet *argv) {
+    janet_arity(argc, 1, 2);
+    int sig;
+    if (janet_checkint(argv[0])) {
+        int32_t s = janet_unwrap_integer(argv[0]);
+        if (s < 0 || s > 9) {
+            janet_panicf("expected user signal between 0 and 9, got %d", s);
+        }
+        sig = JANET_SIGNAL_USER0 + s;
+    } else {
+        JanetKeyword kw = janet_getkeyword(argv, 0);
+        if (!janet_cstrcmp(kw, "yield")) sig = JANET_SIGNAL_YIELD;
+        if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR;
+        if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG;
+        janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
+    }
+    Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
+    janet_signalv(sig, payload);
+}
+
 static const JanetReg corelib_cfuns[] = {
     {
         "native", janet_core_native,
@@ -679,6 +699,11 @@ static const JanetReg corelib_cfuns[] = {
         JDOC("(slice x &opt start end)\n\n"
              "Extract a sub-range of an indexed data strutrue or byte sequence.")
     },
+    {
+        "signal", janet_core_signal,
+        JDOC("(signal what x)\n\n"
+             "Raise a signal with payload x. ")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/fiber.c

@@ -386,6 +386,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
                             JANET_FIBER_MASK_USER |
                             JANET_FIBER_MASK_YIELD;
                         break;
+                    case 't':
+                        fiber->flags |=
+                            JANET_FIBER_MASK_ERROR |
+                            JANET_FIBER_MASK_USER0 |
+                            JANET_FIBER_MASK_USER1 |
+                            JANET_FIBER_MASK_USER2 |
+                            JANET_FIBER_MASK_USER3 |
+                            JANET_FIBER_MASK_USER4;
+                        break;
                     case 'd':
                         fiber->flags |= JANET_FIBER_MASK_DEBUG;
                         break;
@@ -448,6 +457,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetFiber *fiber = janet_getfiber(argv, 0);
+    JanetFiberStatus s = janet_fiber_status(fiber);
+    int isFinished = s == JANET_STATUS_DEAD ||
+                     s == JANET_STATUS_ERROR ||
+                     s == JANET_STATUS_USER0 ||
+                     s == JANET_STATUS_USER1 ||
+                     s == JANET_STATUS_USER2 ||
+                     s == JANET_STATUS_USER3 ||
+                     s == JANET_STATUS_USER4;
+    return janet_wrap_boolean(!isFinished);
+}
+
 static const JanetReg fiber_cfuns[] = {
     {
         "fiber/new", cfun_fiber_new,
@@ -463,6 +486,7 @@ static const JanetReg fiber_cfuns[] = {
              "\ta - block all signals\n"
              "\td - block debug signals\n"
              "\te - block error signals\n"
+             "\tt - block termination signals: error + user[0-4]\n"
              "\tu - block user signals\n"
              "\ty - block yield signals\n"
              "\t0-9 - block a specific user signal\n\n"
@@ -513,6 +537,11 @@ static const JanetReg fiber_cfuns[] = {
              "Sets the environment table for a fiber. Set to nil to remove the current "
              "environment.")
     },
+    {
+        "fiber/can-resume?", cfun_fiber_can_resume,
+        JDOC("(fiber/can-resume? fiber)\n\n"
+             "Check if a fiber is finished and cannot be resumed.")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/vm.c

@@ -1249,6 +1249,7 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
     }
     if (old_status == JANET_STATUS_ALIVE ||
             old_status == JANET_STATUS_DEAD ||
+            (old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
             old_status == JANET_STATUS_ERROR) {
         const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
                                            janet_status_names[old_status]);