add guard function

include/lang2/builtins.x.h

@@ -28,4 +28,5 @@ XFUNCTION("if", l2_builtin_if)
 XFUNCTION("loop", l2_builtin_loop)
 XFUNCTION("while", l2_builtin_while)
 XFUNCTION("for", l2_builtin_for)
+XFUNCTION("guard", l2_builtin_guard)
 #endif

include/lang2/vm/vm.h

@@ -24,6 +24,7 @@ enum l2_value_type {
 	L2_VAL_TYPE_FUNCTION,
 	L2_VAL_TYPE_CFUNCTION,
 	L2_VAL_TYPE_CONTINUATION,
+	L2_VAL_TYPE_RETURN,
 	L2_VAL_TYPE_ERROR,
 };
 
@@ -71,6 +72,7 @@ struct l2_vm_value {
 		} func;
 		l2_vm_cfunction cfunc;
 		struct l2_vm_contcontext *cont;
+		l2_word ret;
 		char *error;
 	};
 };

lib/vm/builtins.c

@@ -56,13 +56,17 @@ static void print_val(struct l2_vm *vm, struct l2_io_writer *out, struct l2_vm_v
 			l2_io_printf(out, "(function)");
 			break;
 
-		case L2_VAL_TYPE_ERROR:
-			l2_io_printf(out, "(error: %s)", val->error);
-			break;
-
 		case L2_VAL_TYPE_CONTINUATION:
 			l2_io_printf(out, "(continuation)");
 			break;
+
+		case L2_VAL_TYPE_RETURN:
+			l2_io_printf(out, "(return)");
+			break;
+
+		case L2_VAL_TYPE_ERROR:
+			l2_io_printf(out, "(error: %s)", val->error);
+			break;
 	}
 }
 
@@ -253,6 +257,7 @@ l2_word l2_builtin_len(struct l2_vm *vm, l2_word argc, l2_word *argv) {
 	case L2_VAL_TYPE_CFUNCTION:
 	case L2_VAL_TYPE_ERROR:
 	case L2_VAL_TYPE_CONTINUATION:
+	case L2_VAL_TYPE_RETURN:
 		break;
 
 	case L2_VAL_TYPE_BUFFER:
@@ -462,3 +467,56 @@ l2_word l2_builtin_for(struct l2_vm *vm, l2_word argc, l2_word *argv) {
 	cont->cont = &ctx->base;
 	return cont_id;
 }
+
+static l2_word guard_callback(struct l2_vm *vm, l2_word retval, l2_word cont_id) {
+	struct l2_vm_value *ret = &vm->values[cont_id];
+	free(ret->cont);
+	ret->flags = L2_VAL_TYPE_RETURN;
+	ret->ret = retval;
+	return cont_id;
+}
+
+l2_word l2_builtin_guard(struct l2_vm *vm, l2_word argc, l2_word *argv) {
+	if (argc != 1 && argc != 2) {
+		return l2_vm_error(vm, "Expected 1 or 2 arguments");
+	}
+
+	struct l2_vm_value *cond = &vm->values[argv[0]];
+	if (l2_value_get_type(cond) == L2_VAL_TYPE_ERROR) {
+		return argv[0];
+	}
+
+	if (argc == 1) {
+		if (!l2_vm_val_is_true(vm, cond)) {
+			return vm->knone;
+		}
+
+		l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_RETURN, 0);
+		vm->values[ret_id].ret = vm->knone;
+		return ret_id;
+	}
+
+	struct l2_vm_value *body = &vm->values[argv[1]];
+	if (l2_value_get_type(body) == L2_VAL_TYPE_ERROR) {
+		return argv[1];
+	}
+
+	if (!l2_vm_val_is_true(vm, cond)) {
+		return vm->knone;
+	}
+
+	struct l2_vm_contcontext *ctx = malloc(sizeof(*ctx));
+	if (ctx == NULL) {
+		return l2_vm_error(vm, "Allocation failure");
+	}
+
+	ctx->callback = guard_callback;
+	ctx->marker = NULL;
+	ctx->args = vm->knone;
+
+	l2_word cont_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0);
+	struct l2_vm_value *cont = &vm->values[cont_id];
+	cont->extra.cont_call = argv[1];
+	cont->cont = ctx;
+	return cont_id;
+}

lib/vm/print.c

@@ -101,14 +101,18 @@ void l2_vm_print_val(struct l2_vm_value *val) {
 		printf("C FUNCTION, %8jx\n", (uintmax_t)val->cfunc);
 		break;
 
-	case L2_VAL_TYPE_ERROR:
-		printf("ERROR, %s\n", val->error);
-		break;
-
 	case L2_VAL_TYPE_CONTINUATION:
 		printf("CONTINUATION, call %u, cont %08jx\n",
 				val->extra.cont_call, (uintmax_t)val->cont);
 		break;
+
+	case L2_VAL_TYPE_RETURN:
+		printf("RETURN, ret %u\n", val->ret);
+		break;
+
+	case L2_VAL_TYPE_ERROR:
+		printf("ERROR, %s\n", val->error);
+		break;
 	}
 }
 
@@ -141,8 +145,8 @@ void l2_vm_print_stack(struct l2_vm *vm) {
 
 void l2_vm_print_fstack(struct l2_vm *vm) {
 	for (l2_word i = 0; i < vm->fsptr; ++i) {
-		printf("  %i: %i, ret %i, stack base %i\n",
-				i, vm->fstack[i].ns, vm->fstack[i].retptr, vm->fstack[i].sptr);
+		printf("  %i: %i, ret %i, stack base %u\n",
+				i, vm->fstack[i].ns, (int)vm->fstack[i].retptr, vm->fstack[i].sptr);
 	}
 }
 

lib/vm/vm.c

@@ -150,8 +150,9 @@ const char *l2_value_type_name(enum l2_value_type typ) {
 	case L2_VAL_TYPE_NAMESPACE: return "NAMESPACE";
 	case L2_VAL_TYPE_FUNCTION: return "FUNCTION";
 	case L2_VAL_TYPE_CFUNCTION: return "CFUNCTION";
-	case L2_VAL_TYPE_ERROR: return "ERROR";
 	case L2_VAL_TYPE_CONTINUATION: return "CONTINUATION";
+	case L2_VAL_TYPE_RETURN: return "RETURN";
+	case L2_VAL_TYPE_ERROR: return "ERROR";
 	}
 
 	return "(unknown)";
@@ -237,7 +238,7 @@ void l2_vm_init(struct l2_vm *vm, unsigned char *ops, size_t opslen) {
 	vm->values[root].ns = NULL;
 	vm->values[root].flags = L2_VAL_TYPE_NAMESPACE;
 	vm->fstack[vm->fsptr].ns = root;
-	vm->fstack[vm->fsptr].retptr = 0;
+	vm->fstack[vm->fsptr].retptr = ~(l2_word)0;
 	vm->fstack[vm->fsptr].sptr = 0;
 	vm->fsptr += 1;
 
@@ -359,6 +360,8 @@ static void call_func(
 
 static void after_cfunc_return(struct l2_vm *vm) {
 	if (
+			l2_value_get_type(&vm->values[vm->stack[vm->sptr - 1]]) ==
+				L2_VAL_TYPE_RETURN ||
 			l2_value_get_type(&vm->values[vm->stack[vm->sptr - 1]]) ==
 				L2_VAL_TYPE_CONTINUATION ||
 			(vm->sptr >= 2 &&
@@ -371,6 +374,24 @@ static void after_cfunc_return(struct l2_vm *vm) {
 static void after_func_return(struct l2_vm *vm) {
 	struct l2_vm_value *ret = &vm->values[vm->stack[vm->sptr - 1]];
 
+	if (l2_value_get_type(ret) == L2_VAL_TYPE_RETURN) {
+		l2_word retval = ret->ret;
+		l2_word retptr = vm->fstack[vm->fsptr - 1].retptr;
+		l2_word sptr = vm->fstack[vm->fsptr - 1].sptr;
+		if (retptr == ~(l2_word)0) {
+			vm->halted = 1;
+			return;
+		}
+
+		vm->fsptr -= 1;
+		vm->sptr = sptr;
+		vm->iptr = retptr;
+		vm->stack[vm->sptr++] = retval;
+
+		after_func_return(vm);
+		return;
+	}
+
 	// If the function returns a continuation, we leave that continuation
 	// on the stack to be handled later, then call the function
 	if (l2_value_get_type(ret) == L2_VAL_TYPE_CONTINUATION) {

test/examples/builtins.l2.expected

@@ -57,12 +57,12 @@
 
 print
 (none)
-(true) (false) (atom 25)
+(true) (false) (atom 26)
 100
 100.5
 255
 Hello World
-[(none) (true) (false) (atom 25) 100.1 Nope (namespace) (function)]
+[(none) (true) (false) (atom 26) 100.1 Nope (namespace) (function)]
 (namespace) (namespace)
 
 len