continuations rework, control flow test

include/lang2/builtins.x.h

-// X macro: Define a macro named X, then include this file, then undef X.
-
 #ifdef XNAME
 XNAME("none", knone)
 #endif

include/lang2/vm/vm.h

 enum l2_value_flags {
 	L2_VAL_MARKED = 1 << 7,
 	L2_VAL_CONST = 1 << 6,
-	L2_VAL_CONT_CALLBACK = 1 << 6, // Re-use the const bit
 	L2_VAL_SBO = 1 << 5,
 };
 
 
 #define l2_value_get_type(val) ((enum l2_value_type)((val)->flags & 0x0f))
 
+l2_word *l2_value_arr_data(struct l2_vm *vm, struct l2_vm_value *val);
 l2_word l2_value_arr_get(struct l2_vm *vm, struct l2_vm_value *val, l2_word k);
 l2_word l2_value_arr_set(struct l2_vm *vm, struct l2_vm_value *val, l2_word k, l2_word v);
 

lib/vm/vm.c

 	return "(unknown)";
 }
 
+l2_word *l2_value_arr_data(struct l2_vm *vm, struct l2_vm_value *val) {
+	if (val->flags & L2_VAL_SBO) {
+		return val->shortarray;
+	} else if (val->array) {
+		return val->array->data;
+	} else {
+		return NULL;
+	}
+}
+
 l2_word l2_value_arr_get(struct l2_vm *vm, struct l2_vm_value *val, l2_word k) {
 	if (k >= val->extra.arr_length) {
 		return vm->knone;
 	}
 }
 
+static void call_func_with_args(
+		struct l2_vm *vm, l2_word func_id, l2_word args_id);
+static void call_func(
+		struct l2_vm *vm, l2_word func_id,
+		l2_word argc, l2_word *argv);
+
+static void after_func_return(struct l2_vm *vm) {
+	// TODO: Rewrite parts of this into a loop. Currently, continuously calling
+	//       a C function with continuations will stack overflow.
+	struct l2_vm_value *ret = &vm->values[vm->stack[vm->sptr - 1]];
+
+	// 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) {
+		if (ret->cont && ret->cont->args != vm->knone) {
+			struct l2_vm_value *args = &vm->values[ret->cont->args];
+			struct l2_vm_value *func = &vm->values[ret->extra.cont_call];
+
+			// We can optimize calling a non-C function by re-using the
+			// args array rather than allocating a new one
+			if (l2_value_get_type(func) == L2_VAL_TYPE_FUNCTION) {
+				call_func_with_args(vm, ret->extra.cont_call, ret->cont->args);
+			} else {
+				call_func(
+						vm, ret->extra.cont_call, args->extra.arr_length,
+						l2_value_arr_data(vm, args));
+			}
+		} else {
+			call_func(vm, ret->extra.cont_call, 0, NULL);
+		}
+
+		return;
+	}
+
+	// If the value right below the returned value is a continuation,
+	// it's a continuation left on the stack to be handled later - i.e now
+	if (
+			vm->sptr >= 2 &&
+			l2_value_get_type(&vm->values[vm->stack[vm->sptr - 2]]) ==
+				L2_VAL_TYPE_CONTINUATION) {
+		struct l2_vm_value *cont = &vm->values[vm->stack[vm->sptr - 2]];
+
+		// If it's just a basic continuation, don't need to do anything
+		if (cont->cont == NULL || cont->cont->callback == NULL) {
+			// Return the return value of the function, discard the continuation
+			vm->stack[vm->sptr - 2] = vm->stack[vm->sptr - 1];
+			vm->sptr -= 1;
+			return;
+		}
+
+		// After this, the original return value and the continuation
+		// are both replaced by whatever the callback returned
+		l2_word contret = cont->cont->callback(
+				vm, vm->stack[vm->sptr - 1], vm->stack[vm->sptr - 2]);
+		vm->stack[vm->sptr - 2] = contret;
+		vm->sptr -= 1;
+
+		after_func_return(vm);
+		return;
+	}
+}
+
 static void call_func_with_args(struct l2_vm *vm, l2_word func_id, l2_word args_id) {
 	l2_word stack_base = vm->sptr;
 	vm->stack[vm->sptr++] = args_id;
 		// Make this a while loop, because using call_func would
 		// make the call stack depth unbounded
 		vm->stack[vm->sptr++] = func->cfunc(vm, argc, argv);
-		while (1) {
-			l2_word cont_id = vm->stack[vm->sptr - 1];
-			struct l2_vm_value *cont = &vm->values[cont_id];
-			if (l2_value_get_type(cont) != L2_VAL_TYPE_CONTINUATION) {
-				break;
-			}
-
-			// If there's no callback it's easy, just call the function
-			// it wants us to call
-			l2_word call_id = cont->extra.cont_call;
-			if (cont->cont == NULL) {
-				vm->sptr -= 1;
-				call_func(vm, call_id, 0, NULL);
-				break;
-			}
-
-			struct l2_vm_value *call = &vm->values[call_id];
-
-			if (l2_value_get_type(call) == L2_VAL_TYPE_CFUNCTION) {
-				int argc = 0;
-				l2_word *argv = NULL;
-				if (cont->cont && cont->cont->args != 0) {
-					struct l2_vm_value *args = &vm->values[cont->cont->args];
-					if (l2_value_get_type(args) != L2_VAL_TYPE_ARRAY) {
-						vm->stack[vm->sptr - 1] = l2_vm_type_error(vm, args);
-						break;
-					}
-
-					argc = args->extra.arr_length;
-					if (args->flags & L2_VAL_SBO) {
-						argv = args->shortarray;
-					} else {
-						argv = args->array->data;
-					}
-				}
-
-				l2_word retval = call->cfunc(vm, argc, argv);
-				vm->stack[vm->sptr - 1] = cont->cont->callback(vm, retval, cont_id);
-			} else if (l2_value_get_type(call) == L2_VAL_TYPE_FUNCTION) {
-				// Leave the continuation on the stack,
-				// let the L2_OP_RET code deal with it
-				cont->flags |= L2_VAL_CONT_CALLBACK;
-				if (cont->cont && cont->cont->args) {
-					call_func_with_args(vm, call_id, cont->cont->args);
-				} else {
-					call_func(vm, call_id, 0, NULL);
-				}
-				break;
-			} else {
-				l2_word err = l2_vm_type_error(vm, call);
-				vm->stack[vm->sptr - 1] = cont->cont->callback(vm, err, cont_id);
-			}
-		}
-
+		after_func_return(vm);
 		return;
 	}
 
 
 	l2_word args_id = alloc_val(vm);
 	struct l2_vm_value *args = &vm->values[args_id];
+	args->flags = L2_VAL_TYPE_ARRAY | L2_VAL_SBO;
 	args->extra.arr_length = argc;
-	if (argc <= 2) {
-		args->flags = L2_VAL_TYPE_ARRAY | L2_VAL_SBO;
-		memcpy(args->shortarray, argv, argc * sizeof(l2_word));
-	} else {
-		args->flags = L2_VAL_TYPE_ARRAY;
-		args->array = malloc(
-				sizeof(struct l2_vm_array) + sizeof(l2_word) * argc);
-		args->array->size = argc;
-		memcpy(args->array->data, argv, argc * sizeof(l2_word));
+	if (argc > 0) {
+		if (argc <= 2) {
+			memcpy(args->shortarray, argv, argc * sizeof(l2_word));
+		} else {
+			args->flags = L2_VAL_TYPE_ARRAY;
+			args->array = malloc(
+					sizeof(struct l2_vm_array) + sizeof(l2_word) * argc);
+			args->array->size = argc;
+			memcpy(args->array->data, argv, argc * sizeof(l2_word));
+		}
 	}
 
 	call_func_with_args(vm, func_id, args_id);
 			vm->fsptr -= 1;
 			vm->sptr = sptr;
 			vm->iptr = retptr;
+			vm->stack[vm->sptr++] = retval;
 
-			l2_word cont_id;
-			struct l2_vm_value *cont = NULL;
-			if (vm->sptr > 0) {
-				cont_id = vm->stack[vm->sptr - 1];
-				cont = &vm->values[cont_id];
-			}
-
-			int iscont =
-				cont != NULL && l2_value_get_type(cont) == L2_VAL_TYPE_CONTINUATION;
-			int nocallback =
-				!iscont || (cont->flags & L2_VAL_CONT_CALLBACK && cont->cont == NULL);
-			if (nocallback) {
-				if (iscont) {
-					vm->stack[vm->sptr - 1] = retval;
-				} else {
-					vm->stack[vm->sptr++] = retval;
-				}
-				break;
-			}
-
-			if (cont->flags & L2_VAL_CONT_CALLBACK) {
-				retval = cont->cont->callback(vm, retval, cont_id);
-				cont_id = retval;
-				cont = &vm->values[cont_id];
-
-				if (l2_value_get_type(cont) != L2_VAL_TYPE_CONTINUATION) {
-					vm->stack[vm->sptr - 1] = retval;
-					break;
-				}
-			}
-
-			cont->flags |= L2_VAL_CONT_CALLBACK;
-			if (cont->cont && cont->cont->args != 0) {
-				call_func_with_args(vm, cont->extra.cont_call, cont->cont->args);
-			} else {
-				call_func(vm, cont->extra.cont_call, 0, NULL);
-			}
+			after_func_return(vm);
 		}
 		break;
 

test/examples/builtins.l2.expected

 
 print
 (none)
-(true) (false) (atom 23)
+(true) (false) (atom 25)
 100
 100.5
 255
 Hello World
-[(none) (true) (false) (atom 23) 100.1 Nope (namespace) (function)]
+[(none) (true) (false) (atom 25) 100.1 Nope (namespace) (function)]
 (namespace) (namespace)
 
 len

test/examples/control-flow.l2

+print "Run loop 10 times"
+i := 0
+loop {
+	print "Hello World"
+	i = i + 1
+	if i >= 10 {'stop}
+}
+
+print "\nWith while this time"
+i = 0
+while {i < 10} {
+	print "Hallo Wrodl"
+	i = i + 1
+}
+
+print "\nAnd with the for loop"
+i = 0
+iter := {
+	j := i
+	i = i + 1
+	if j < 10 {j} {'stop}
+}
+for iter { print "Hello with" $ }
+
+print "\nArray iterator"
+array-iter := {
+	arr := $.0
+	idx := 0
+	{
+		if idx >= (len arr) {
+			'stop
+		} {
+			j := idx
+			idx = idx + 1
+			[j arr.(j)]
+		}
+	}
+}
+for (array-iter ["hello" "world" "how" "are" "you" 10 20 'true]) print

test/examples/control-flow.l2.expected

+Run loop 10 times
+Hello World
+Hello World
+Hello World
+Hello World
+Hello World
+Hello World
+Hello World
+Hello World
+Hello World
+Hello World
+
+With while this time
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+Hallo Wrodl
+
+And with the for loop
+Hello with [0]
+Hello with [1]
+Hello with [2]
+Hello with [3]
+Hello with [4]
+Hello with [5]
+Hello with [6]
+Hello with [7]
+Hello with [8]
+Hello with [9]
+
+Array iterator
+[0 hello]
+[1 world]
+[2 how]
+[3 are]
+[4 you]
+[5 10]
+[6 20]
+[7 (true)]

test/src/examples.t.c

 	check("functions.l2");
 	check("dynamic-lookups.l2");
 	check("builtins.l2");
+	check("control-flow.l2");
 
 	if (error_message != NULL) {
 		free(error_message);