| 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; | ||||
| } | } | ||||