X("/", l2_builtin_div) | X("/", l2_builtin_div) | ||||
X("print", l2_builtin_print) | X("print", l2_builtin_print) | ||||
X("len", l2_builtin_len) | X("len", l2_builtin_len) | ||||
X("if", l2_builtin_if) | |||||
#endif | #endif |
struct l2_vm; | struct l2_vm; | ||||
struct l2_vm_array; | struct l2_vm_array; | ||||
struct l2_vm_args; | |||||
typedef l2_word (*l2_vm_cfunction)(struct l2_vm *vm, l2_word argc, l2_word *argv); | typedef l2_word (*l2_vm_cfunction)(struct l2_vm *vm, l2_word argc, l2_word *argv); | ||||
struct l2_vm_args { | |||||
l2_word argc; | |||||
}; | |||||
enum l2_value_type { | enum l2_value_type { | ||||
L2_VAL_TYPE_NONE, | L2_VAL_TYPE_NONE, | ||||
L2_VAL_TYPE_ATOM, | L2_VAL_TYPE_ATOM, | ||||
L2_VAL_TYPE_NAMESPACE, | L2_VAL_TYPE_NAMESPACE, | ||||
L2_VAL_TYPE_FUNCTION, | L2_VAL_TYPE_FUNCTION, | ||||
L2_VAL_TYPE_CFUNCTION, | L2_VAL_TYPE_CFUNCTION, | ||||
L2_VAL_TYPE_CONTINUATION, | |||||
L2_VAL_TYPE_ERROR, | L2_VAL_TYPE_ERROR, | ||||
}; | }; | ||||
l2_word ns; | l2_word ns; | ||||
} func; | } func; | ||||
l2_vm_cfunction cfunc; | l2_vm_cfunction cfunc; | ||||
struct { | |||||
l2_word call; | |||||
l2_word arg; | |||||
} cont; | |||||
char *error; | char *error; | ||||
}; | }; | ||||
}; | }; |
case L2_VAL_TYPE_ERROR: | case L2_VAL_TYPE_ERROR: | ||||
l2_io_printf(out, "(error: %s)", val->error); | l2_io_printf(out, "(error: %s)", val->error); | ||||
break; | break; | ||||
case L2_VAL_TYPE_CONTINUATION: | |||||
l2_io_printf(out, "(continuation)"); | |||||
break; | |||||
} | } | ||||
} | } | ||||
} | } | ||||
l2_word l2_builtin_len(struct l2_vm *vm, l2_word argc, l2_word *argv) { | l2_word l2_builtin_len(struct l2_vm *vm, l2_word argc, l2_word *argv) { | ||||
if (argc < 1) { | |||||
return l2_vm_error(vm, "Expected at least 1 argument"); | |||||
if (argc != 1) { | |||||
return l2_vm_error(vm, "Expected 1 argument"); | |||||
} | } | ||||
l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0); | l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0); | ||||
case L2_VAL_TYPE_FUNCTION: | case L2_VAL_TYPE_FUNCTION: | ||||
case L2_VAL_TYPE_CFUNCTION: | case L2_VAL_TYPE_CFUNCTION: | ||||
case L2_VAL_TYPE_ERROR: | case L2_VAL_TYPE_ERROR: | ||||
case L2_VAL_TYPE_CONTINUATION: | |||||
break; | break; | ||||
case L2_VAL_TYPE_BUFFER: | case L2_VAL_TYPE_BUFFER: | ||||
return ret_id; | return ret_id; | ||||
} | } | ||||
l2_word l2_builtin_if(struct l2_vm *vm, l2_word argc, l2_word *argv) { | |||||
if (argc != 2 && argc != 3) { | |||||
return l2_vm_error(vm, "Expected 2 or 3 arguments"); | |||||
} | |||||
struct l2_vm_value *cond = &vm->values[argv[0]]; | |||||
if ( | |||||
l2_vm_value_type(cond) == L2_VAL_TYPE_ATOM && | |||||
cond->atom == vm->values[vm->ktrue].atom) { | |||||
l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0); | |||||
struct l2_vm_value *ret = &vm->values[ret_id]; | |||||
ret->cont.call = argv[1]; | |||||
ret->cont.arg = 0; | |||||
return ret_id; | |||||
} else if (argc == 3) { | |||||
l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0); | |||||
struct l2_vm_value *ret = &vm->values[ret_id]; | |||||
ret->cont.call = argv[2]; | |||||
ret->cont.arg = 0; | |||||
return ret_id; | |||||
} else { | |||||
return 0; | |||||
} | |||||
} |
case L2_VAL_TYPE_ERROR: | case L2_VAL_TYPE_ERROR: | ||||
printf("ERROR, %s\n", val->error); | printf("ERROR, %s\n", val->error); | ||||
break; | break; | ||||
case L2_VAL_TYPE_CONTINUATION: | |||||
printf("CONTINUATION, call %u, arg %u\n", val->cont.call, val->cont.arg); | |||||
break; | |||||
} | } | ||||
} | } | ||||
case L2_VAL_TYPE_FUNCTION: return "FUNCTION"; | case L2_VAL_TYPE_FUNCTION: return "FUNCTION"; | ||||
case L2_VAL_TYPE_CFUNCTION: return "CFUNCTION"; | case L2_VAL_TYPE_CFUNCTION: return "CFUNCTION"; | ||||
case L2_VAL_TYPE_ERROR: return "ERROR"; | case L2_VAL_TYPE_ERROR: return "ERROR"; | ||||
case L2_VAL_TYPE_CONTINUATION: return "CONTINUATION"; | |||||
} | } | ||||
return "(unknown)"; | return "(unknown)"; | ||||
// C functions are called differently from language functions | // C functions are called differently from language functions | ||||
if (typ == L2_VAL_TYPE_CFUNCTION) { | if (typ == L2_VAL_TYPE_CFUNCTION) { | ||||
// 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); | vm->stack[vm->sptr++] = func->cfunc(vm, argc, argv); | ||||
while (1) { | |||||
struct l2_vm_value *val = &vm->values[vm->stack[vm->sptr - 1]]; | |||||
if (l2_vm_value_type(val) != L2_VAL_TYPE_CONTINUATION) { | |||||
break; | |||||
} | |||||
l2_word cont_id = val->cont.call; | |||||
struct l2_vm_value *cont = &vm->values[cont_id]; | |||||
l2_word new_argc; | |||||
l2_word new_argv[1]; | |||||
if (val->cont.arg == 0) { | |||||
new_argc = 0; | |||||
} else { | |||||
new_argc = 1; | |||||
new_argv[0] = val->cont.arg; | |||||
} | |||||
if (l2_vm_value_type(cont) == L2_VAL_TYPE_CFUNCTION) { | |||||
vm->stack[vm->sptr - 1] = cont->cfunc(vm, new_argc, new_argv); | |||||
} else { | |||||
vm->sptr -= 1; | |||||
call_func(vm, cont_id, new_argc, new_argv); | |||||
break; | |||||
} | |||||
} | |||||
return; | return; | ||||
} | } | ||||