Add break special.

The break special form can break out of both loops
and functions with an early (nil) return. Mainly useful
for generated code in macros, and should probably be discouraged
in user written code.

src/core/compile.c

@@ -97,7 +97,6 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
     scope.syms = NULL;
     scope.envs = NULL;
     scope.defs = NULL;
-    scope.selfconst = -1;
     scope.bytecode_start = janet_v_count(c->buffer);
     scope.flags = flags;
     scope.parent = c->scope;

src/core/compile.h

@@ -96,6 +96,7 @@ struct JanetSlot {
 #define JANET_SCOPE_TOP 4
 #define JANET_SCOPE_UNUSED 8
 #define JANET_SCOPE_CLOSURE 16
+#define JANET_SCOPE_WHILE 32
 
 /* A symbol and slot pair */
 typedef struct SymPair {
@@ -131,9 +132,6 @@ struct JanetScope {
      * that corresponds to the direct parent's stack will always have value 0. */
     int32_t *envs;
 
-    /* Where to add reference to self in constants */
-    int32_t selfconst;
-
     int32_t bytecode_start;
     int flags;
 };

src/core/specials.c

@@ -471,6 +471,41 @@ static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
     return janet_v_count(scope->defs) - 1;
 }
 
+/*
+ * break
+ *
+ * jump :end or retn if in function
+ */
+static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) {
+    JanetCompiler *c = opts.compiler;
+    JanetScope *scope = c->scope;
+    (void) argv;
+    if (argn != 0) {
+        janetc_cerror(c, "expected no arguments");
+        return janetc_cslot(janet_wrap_nil());
+    }
+    while (scope) {
+        if (scope->flags & (JANET_SCOPE_FUNCTION | JANET_SCOPE_WHILE))
+            break;
+        scope = scope->parent;
+    }
+    if (NULL == scope) {
+        janetc_cerror(c, "break must occur in while loop or closure");
+        return janetc_cslot(janet_wrap_nil());
+    }
+    if (scope->flags | JANET_SCOPE_FUNCTION) {
+        /* Just return, either in IIFE or closure body */
+        janetc_emit(c, JOP_RETURN_NIL);
+        JanetSlot s = janetc_cslot(janet_wrap_nil());
+        s.flags |= JANET_SLOT_RETURNED;
+        return s;
+    } else {
+        /* Tag the instruction so the while special can turn it into a proper jump */
+        janetc_emit(c, 0x80 | JOP_JUMP);
+        return janetc_cslot(janet_wrap_nil());
+    }
+}
+
 /*
  * :whiletop
  * ...
@@ -495,7 +530,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
 
     labelwt = janet_v_count(c->buffer);
 
-    janetc_scope(&tempscope, c, 0, "while");
+    janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
 
     /* Compile condition */
     cond = janetc_value(subopts, argv[0]);
@@ -569,6 +604,13 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
     if (!infinite) c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
     c->buffer[labeljt] |= (uint32_t)(labelwt - labeljt) << 8;
 
+    /* Calculate breaks */
+    for (int32_t i = labelwt; i < labeld; i++) {
+        if (c->buffer[i] == (0x80 | JOP_JUMP)) {
+            c->buffer[i] = JOP_JUMP | ((labeld - i) << 8);
+        }
+    }
+
     /* Pop scope and return nil slot */
     janetc_popscope(c);
 
@@ -686,6 +728,7 @@ error2:
 
 /* Keep in lexicographic order */
 static const JanetSpecial janetc_specials[] = {
+    {"break", janetc_break},
     {"def", janetc_def},
     {"do", janetc_do},
     {"fn", janetc_fn},

test/suite5.janet

@@ -43,7 +43,7 @@
    (def b (tarray/new :float64 10 2 64 buf))))
 
 (def a (tarray/new :float64 10))
-(def b (tarray/new :float64 5 2 0 a)) 
+(def b (tarray/new :float64 5 2 0 a))
 
 (assert-no-error
  "fill tarray"
@@ -63,6 +63,15 @@
 (assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
 (assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
 (assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
-        
-(end-suite)
 
+# Break
+
+(var summation 0)
+(for i 0 10
+  (+= summation i)
+  (if (= i 7) (break)))
+(assert (= summation 28) "break 1")
+
+(assert (= nil ((fn [] (break) 4))) "break 2")
+
+(end-suite)