From 2506c49835463bc008f5b84e59eb8782d5265cd4 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 14:47:47 +0400 Subject: [PATCH 01/35] initial prims --- clang/nick/names.c | 19 ++ clang/prim/fn/panic.c | 14 ++ clang/prim/fn/rand.c | 13 ++ clang/prim/fn/read_bytes.c | 73 +++++++ clang/prim/fn/read_file.c | 184 +++++++++++++++++ clang/prim/fn/write_bytes.c | 113 +++++++++++ clang/prim/fn/write_file.c | 110 +++++++++++ clang/prim/init.c | 6 + clang/prim/string.c | 384 ++++++++++++++++++++++++++++++++++++ 9 files changed, 916 insertions(+) create mode 100644 clang/prim/fn/panic.c create mode 100644 clang/prim/fn/rand.c create mode 100644 clang/prim/fn/read_bytes.c create mode 100644 clang/prim/fn/read_file.c create mode 100644 clang/prim/fn/write_bytes.c create mode 100644 clang/prim/fn/write_file.c create mode 100644 clang/prim/string.c diff --git a/clang/nick/names.c b/clang/nick/names.c index a9aba370..67f375a6 100644 --- a/clang/nick/names.c +++ b/clang/nick/names.c @@ -6,6 +6,21 @@ static u32 SYM_SUC = 0; static u32 SYM_NIL = 0; static u32 SYM_CON = 0; static u32 SYM_CHR = 0; +static u32 SYM_U8 = 0; +static u32 SYM_BYT = 0; +static u32 SYM_OK = 0; +static u32 SYM_ERR = 0; + +// Backward-compatible aliases used across the runtime. +#define NAM_ZER SYM_ZER +#define NAM_SUC SYM_SUC +#define NAM_NIL SYM_NIL +#define NAM_CON SYM_CON +#define NAM_CHR SYM_CHR +#define NAM_U8 SYM_U8 +#define NAM_BYT SYM_BYT +#define NAM_OK SYM_OK +#define NAM_ERR SYM_ERR fn void symbols_init(void) { SYM_ZER = table_find("ZER", 3); @@ -13,4 +28,8 @@ fn void symbols_init(void) { SYM_NIL = table_find("NIL", 3); SYM_CON = table_find("CON", 3); SYM_CHR = table_find("CHR", 3); + SYM_U8 = table_find("U8", 2); + SYM_BYT = table_find("BYT", 3); + SYM_OK = table_find("OK", 2); + SYM_ERR = table_find("ERR", 3); } diff --git a/clang/prim/fn/panic.c b/clang/prim/fn/panic.c new file mode 100644 index 00000000..ebe16587 --- /dev/null +++ b/clang/prim/fn/panic.c @@ -0,0 +1,14 @@ +fn Term prim_fn_log(Term *args); + +// %panic(s) +// ---------------- panic +// !t = %log(s); abort +fn Term prim_fn_panic(Term *args) { + (void)prim_fn_log(args); + exit(1); + return term_new_era(); +} + +fn void prim_panic_init(void) { + prim_register("panic", 5, 1, prim_fn_panic); +} diff --git a/clang/prim/fn/rand.c b/clang/prim/fn/rand.c new file mode 100644 index 00000000..39ed8284 --- /dev/null +++ b/clang/prim/fn/rand.c @@ -0,0 +1,13 @@ +#include + +// %rand(dummy) +// ------------ rand +// NUM +fn Term prim_fn_rand(Term *args) { + (void)args[0]; // dummy arg; arity 1 for now + return term_new_num((u32)rand()); +} + +fn void prim_rand_init(void) { + prim_register("rand", 4, 1, prim_fn_rand); +} diff --git a/clang/prim/fn/read_bytes.c b/clang/prim/fn/read_bytes.c new file mode 100644 index 00000000..0e772197 --- /dev/null +++ b/clang/prim/fn/read_bytes.c @@ -0,0 +1,73 @@ +#include +#include +#include +#include +fn void print_term(Term term); +fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); +fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); +fn Term term_string_printf(const char *fmt, ...); + +// %read_bytes(path) +// ---------------- +// #OK{List<#BYT{NUM}>} | #ERR{String} +fn Term prim_fn_read_bytes(Term *args) { + int MAX_PATH = 1024; + char path[MAX_PATH]; // UTF-8 bytes + const char *OPEN_PATH_ERR_FMT = "ERROR(read_bytes): failed to open path '%s': %s (errno=%d)"; + const char *READ_IO_ERR_FMT = "ERROR(read_bytes): I/O error while reading '%s': %s (errno=%d)"; + + // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. + HStrErr path_err; + if (!term_string_to_utf8_cstr(args[0], path, MAX_PATH, NULL, &path_err)) { + return term_string_from_hstrerr("read_bytes", "path", MAX_PATH, path_err); + } + + // Open file and build an HVM list of #BYT{NUM}. + FILE *file = fopen(path, "rb"); + if (!file) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + } + + // Initialize output list (empty file => #OK{#NIL}). + Term Nil = term_new_ctr(NAM_NIL, 0, 0); + unsigned char c; + // First read distinguishes empty file (EOF) from read error. + if (fread(&c, 1,1, file) != 1) { + if (ferror(file)) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); + } + // First read hit EOF: file is empty, so payload is #NIL. + fclose(file); + return term_new_ctr(NAM_OK, 1, &Nil); + } + Term byt[1] = {term_new_num(c)}; + Term h_t[2] = {term_new_ctr(NAM_BYT, 1, byt), Nil}; + Term result = term_new_ctr(NAM_CON, 2, h_t); // at each step, the list ends in #NIL + + // `curr` is the last #CON in the output List<#BYT{NUM}>. + Term curr = result; + while (fread(&c, 1,1, file) == 1) { + byt[0] = term_new_num(c); + h_t[0] = term_new_ctr(NAM_BYT, 1, byt); + // Append #CON{#BYT{NUM}, #NIL} at curr tail. + heap_set(term_val(curr) + 1, term_new_ctr(NAM_CON, 2, h_t)); + curr = heap_read(term_val(curr) + 1); + } + + if (ferror(file)) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); + } + fclose(file); + return term_new_ctr(NAM_OK, 1, &result); +} + +fn void prim_read_bytes_init(void) { + prim_register("read_bytes", 10, 1, prim_fn_read_bytes); +} diff --git a/clang/prim/fn/read_file.c b/clang/prim/fn/read_file.c new file mode 100644 index 00000000..e7428992 --- /dev/null +++ b/clang/prim/fn/read_file.c @@ -0,0 +1,184 @@ +#include +#include +#include +#include +fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); +fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); +fn Term term_string_printf(const char *fmt, ...); + +fn int utf8_expected_len(u8 b0) { + if (b0 < 0x80) { + return 1; + } + if ((b0 & 0xE0) == 0xC0) { + return 2; + } + if ((b0 & 0xF0) == 0xE0) { + return 3; + } + if ((b0 & 0xF8) == 0xF0) { + return 4; + } + return -1; +} + +fn int utf8_decode_seq(const u8 seq[4], int n, u32 *cp) { + u8 b0 = seq[0]; + if (n == 1) { + *cp = b0; + return 1; + } + + if (n == 2) { + u8 b1 = seq[1]; + if ((b1 & 0xC0) != 0x80) { + return 0; + } + u32 x = ((u32)(b0 & 0x1F) << 6) | (u32)(b1 & 0x3F); + if (x < 0x80) { + return 0; + } + *cp = x; + return 1; + } + + if (n == 3) { + u8 b1 = seq[1]; + u8 b2 = seq[2]; + if ((b1 & 0xC0) != 0x80 || (b2 & 0xC0) != 0x80) { + return 0; + } + u32 x = ((u32)(b0 & 0x0F) << 12) + | ((u32)(b1 & 0x3F) << 6) + | ((u32)(b2 & 0x3F)); + if (x < 0x800 || (x >= 0xD800 && x <= 0xDFFF)) { + return 0; + } + *cp = x; + return 1; + } + + if (n == 4) { + u8 b1 = seq[1]; + u8 b2 = seq[2]; + u8 b3 = seq[3]; + if ((b1 & 0xC0) != 0x80 || (b2 & 0xC0) != 0x80 || (b3 & 0xC0) != 0x80) { + return 0; + } + u32 x = ((u32)(b0 & 0x07) << 18) + | ((u32)(b1 & 0x3F) << 12) + | ((u32)(b2 & 0x3F) << 6) + | ((u32)(b3 & 0x3F)); + if (x < 0x10000 || x > 0x10FFFF) { + return 0; + } + *cp = x; + return 1; + } + + return 0; +} + +// %read_file(path) +// ---------------- +// #OK{List<#CHR{NUM}>} | #ERR{String} +fn Term prim_fn_read_file(Term *args) { + int MAX_PATH = 1024; + char path[MAX_PATH]; // UTF-8 bytes + const char *OPEN_PATH_ERR_FMT = "ERROR(read_file): failed to open path '%s': %s (errno=%d)"; + const char *READ_IO_ERR_FMT = "ERROR(read_file): I/O error while reading '%s': %s (errno=%d)"; + const char *INVALID_UTF8_FMT = "ERROR(read_file): invalid UTF-8 at byte index %i"; + const char *TRUNC_UTF8_FMT = "ERROR(read_file): truncated UTF-8 sequence at byte index %i"; + + // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. + HStrErr path_err; + if (!term_string_to_utf8_cstr(args[0], path, MAX_PATH, NULL, &path_err)) { + return term_string_from_hstrerr("read_file", "path", MAX_PATH, path_err); + } + + FILE *file = fopen(path, "rb"); + if (!file) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + } + + Term Nil = term_new_ctr(NAM_NIL, 0, 0); + Term result = Nil; + Term curr = Nil; + u8 has_node = 0; + + // Incremental UTF-8 decoder state. + u8 seq[4]; + int seq_len = 0; + int seq_need = 0; + int byte_i = 0; + + u8 b; + while (fread(&b, 1, 1, file) == 1) { + if (seq_len == 0) { + seq[0] = b; + seq_len = 1; + seq_need = utf8_expected_len(b); + if (seq_need < 0) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, byte_i) }); + } + } else { + // Continuation bytes must start with bits `10`. + if ((b & 0xC0) != 0x80) { + int seq_start = byte_i - seq_len; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); + } + seq[seq_len] = b; + seq_len += 1; + } + + if (seq_len == seq_need) { + u32 cp = 0; + if (!utf8_decode_seq(seq, seq_need, &cp)) { + int seq_start = byte_i - (seq_need - 1); + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); + } + + Term num = term_new_num(cp); + Term chr = term_new_ctr(NAM_CHR, 1, &num); + Term h_t[2] = {chr, Nil}; + Term node = term_new_ctr(NAM_CON, 2, h_t); + + if (!has_node) { + result = node; + has_node = 1; + } else { + heap_set(term_val(curr) + 1, node); + } + curr = node; + + seq_len = 0; + seq_need = 0; + } + + byte_i += 1; + } + + if (ferror(file)) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); + } + + if (seq_len != 0) { + int seq_start = byte_i - seq_len; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(TRUNC_UTF8_FMT, seq_start) }); + } + + fclose(file); + return term_new_ctr(NAM_OK, 1, &result); +} + +fn void prim_read_file_init(void) { + prim_register("read_file", 9, 1, prim_fn_read_file); +} diff --git a/clang/prim/fn/write_bytes.c b/clang/prim/fn/write_bytes.c new file mode 100644 index 00000000..46e0c73e --- /dev/null +++ b/clang/prim/fn/write_bytes.c @@ -0,0 +1,113 @@ +#include +#include +#include +#include +fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); +fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); +fn Term term_string_printf(const char *fmt, ...); + +// %write_bytes(path, data) +// ------------------------ +// #OK{#NIL} | #ERR{String} +fn Term prim_fn_write_bytes(Term *args) { + int MAX_PATH = 1024; + char path[MAX_PATH]; // UTF-8 bytes + int data_i = 0; + Term data_item = args[1]; + const char *DATA_EXPECTED = "ERROR(write_bytes): invalid `data`; expected #NIL or #CON(#BYT{NUM}, tail)"; + const char *OPEN_PATH_ERR_FMT = "ERROR(write_bytes): failed to open path '%s': %s (errno=%d)"; + const char *DATA_INVALID_BYTE_FMT = "ERROR(write_bytes): invalid byte %llu at `data` index %i; expected 0..255"; + const char *WRITE_IO_ERR_FMT = "ERROR(write_bytes): I/O error while writing '%s': %s (errno=%d)"; + const char *FLUSH_ERR_FMT = "ERROR(write_bytes): failed to flush '%s': %s (errno=%d)"; + const char *CLOSE_ERR_FMT = "ERROR(write_bytes): failed to close '%s': %s (errno=%d)"; + + // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. + HStrErr path_err; + if (!term_string_to_utf8_cstr(args[0], path, MAX_PATH, NULL, &path_err)) { + return term_string_from_hstrerr("write_bytes", "path", MAX_PATH, path_err); + } + + FILE *file = fopen(path, "wb"); + if (!file) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + } + + // Write hvm4 bytes list (#BYT[]) into `file`. + data_item = wnf(data_item); + while (term_tag(data_item) == C02) { + // wnf(data_item) must be List<#BYT{b}> + if (term_ext(data_item) != NAM_CON) { + fclose(file); + Term msg = term_string_printf("%s", DATA_EXPECTED); + return term_new_ctr(NAM_ERR, 1, &msg); + } + + Term head_loc = term_val(data_item); + Term head = heap_read(head_loc + 0); + Term tail = heap_read(head_loc + 1); + head = wnf(head); + + // wnf(head) must be #BYT{b} + if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { + fclose(file); + Term msg = term_string_printf("%s", DATA_EXPECTED); + return term_new_ctr(NAM_ERR, 1, &msg); + } + + Term b_loc = term_val(head); + Term b_trm = heap_read(b_loc); + b_trm = wnf(b_trm); + + // b in #BYT{b} must be NUM + if (term_tag(b_trm) != NUM) { + fclose(file); + Term msg = term_string_printf("%s", DATA_EXPECTED); + return term_new_ctr(NAM_ERR, 1, &msg); + } + + // NUM must fit one byte. + u32 b = term_val(b_trm); + if (b > 0xFF) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(DATA_INVALID_BYTE_FMT, (unsigned long long)b, data_i) }); + } + + unsigned char out = (unsigned char)b; + if (fwrite(&out, 1, 1, file) != 1) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(WRITE_IO_ERR_FMT, path, strerror(err), err) }); + } + + data_i += 1; + // Recurse + data_item = wnf(tail); + } + + if (term_tag(data_item) != C00 || term_ext(data_item) != NAM_NIL) { + fclose(file); + Term msg = term_string_printf("%s", DATA_EXPECTED); + return term_new_ctr(NAM_ERR, 1, &msg); + } + + if (fflush(file) != 0) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(FLUSH_ERR_FMT, path, strerror(err), err) }); + } + + if (fclose(file) != 0) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(CLOSE_ERR_FMT, path, strerror(err), err) }); + } + + Term Nil = term_new_ctr(NAM_NIL, 0, 0); + return term_new_ctr(NAM_OK, 1, &Nil); +} + +fn void prim_write_bytes_init(void) { + prim_register("write_bytes", 11, 2, prim_fn_write_bytes); +} diff --git a/clang/prim/fn/write_file.c b/clang/prim/fn/write_file.c new file mode 100644 index 00000000..dd3e6c8a --- /dev/null +++ b/clang/prim/fn/write_file.c @@ -0,0 +1,110 @@ +#include +#include +#include +#include +fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); +fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); +fn int utf8_encode_scalar(u32 cp, char out[4]); +fn Term term_string_printf(const char *fmt, ...); + +// %write_file(path, data) +// ----------------------- +// #OK{#NIL} | #ERR{String} +fn Term prim_fn_write_file(Term *args) { + int MAX_PATH = 1024; + char path[MAX_PATH]; // UTF-8 bytes + int data_i = 0; + Term data_item = args[1]; + const char *DATA_EXPECTED = "ERROR(write_file): invalid `data`; expected #NIL or #CON(#CHR{NUM}, tail)"; + const char *OPEN_PATH_ERR_FMT = "ERROR(write_file): failed to open path '%s': %s (errno=%d)"; + const char *DATA_INVALID_CP_FMT = "ERROR(write_file): invalid UTF-32 codepoint U+%08llX at `data` index %i"; + const char *WRITE_IO_ERR_FMT = "ERROR(write_file): I/O error while writing '%s': %s (errno=%d)"; + const char *FLUSH_ERR_FMT = "ERROR(write_file): failed to flush '%s': %s (errno=%d)"; + const char *CLOSE_ERR_FMT = "ERROR(write_file): failed to close '%s': %s (errno=%d)"; + + // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. + HStrErr path_err; + if (!term_string_to_utf8_cstr(args[0], path, MAX_PATH, NULL, &path_err)) { + return term_string_from_hstrerr("write_file", "path", MAX_PATH, path_err); + } + + FILE *file = fopen(path, "wb"); + if (!file) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + } + + // Write hvm4 string List<#CHR{NUM}> into file as UTF-8 bytes. + data_item = wnf(data_item); + while (term_tag(data_item) == C02) { + // wnf(data_item) must be List<#CHR{c}> + if (term_ext(data_item) != NAM_CON) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + } + + Term head_loc = term_val(data_item); + Term head = heap_read(head_loc + 0); + Term tail = heap_read(head_loc + 1); + head = wnf(head); + + // wnf(head) must be #CHR{c} + if (term_tag(head) != C01 || term_ext(head) != NAM_CHR) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + } + + Term c_loc = term_val(head); + Term c_trm = wnf(heap_read(c_loc)); + + // c in #CHR{c} must be NUM + if (term_tag(c_trm) != NUM) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + } + + // Encode UTF-32 codepoint (NUM) into UTF-8 bytes. + u32 cp = term_val(c_trm); + char cp_utf8[4]; + int n_bytes = utf8_encode_scalar(cp, cp_utf8); + if (n_bytes < 0) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(DATA_INVALID_CP_FMT, (unsigned long long)cp, data_i) }); + } + + if (fwrite(cp_utf8, 1, (size_t)n_bytes, file) != (size_t)n_bytes) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(WRITE_IO_ERR_FMT, path, strerror(err), err) }); + } + + data_i += 1; + // Recurse + data_item = wnf(tail); + } + + if (term_tag(data_item) != C00 || term_ext(data_item) != NAM_NIL) { + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + } + + if (fflush(file) != 0) { + // Capture errno before fclose because fclose may overwrite it. + int err = errno; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(FLUSH_ERR_FMT, path, strerror(err), err) }); + } + + if (fclose(file) != 0) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(CLOSE_ERR_FMT, path, strerror(err), err) }); + } + + Term Nil = term_new_ctr(NAM_NIL, 0, 0); + return term_new_ctr(NAM_OK, 1, &Nil); +} + +fn void prim_write_file_init(void) { + prim_register("write_file", 10, 2, prim_fn_write_file); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index f5d1348d..22315b4e 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -1,3 +1,9 @@ fn void prim_init(void) { prim_log_init(); + prim_panic_init(); + prim_rand_init(); + prim_read_bytes_init(); + prim_write_bytes_init(); + prim_read_file_init(); + prim_write_file_init(); } diff --git a/clang/prim/string.c b/clang/prim/string.c new file mode 100644 index 00000000..df65680d --- /dev/null +++ b/clang/prim/string.c @@ -0,0 +1,384 @@ +#include +#include +#include + +// Type helpers +typedef enum HStrErrKind HStrErrKind; +typedef struct HStrErr HStrErr; + +// UTF-8 helpers +fn int utf8_encode_scalar(u32 cp, char out[4]); +fn int utf8_decode_next_cstr(const char *s, u32 *idx, u32 *cp); + +// Term <-> c string, conversion helpers +fn int term_chr_from_scalar(u32 cp, Term *out); +fn Term term_string_from_utf8(const char *s); +fn Term term_string_vprintf(const char *fmt, va_list ap); +fn Term term_string_printf(const char *fmt, ...); +fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); +fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); + +// Local utility +fn void hstr_set(HStrErr *err, HStrErrKind kind, int index, int bytes, u64 cp); + +enum HStrErrKind { + HSTR_OK = 0, + HSTR_BAD_SHAPE, // Not #NIL / #CON(#CHR{NUM}, tail) + HSTR_BAD_CP, // Invalid UTF-32 scalar value in #CHR{NUM} + HSTR_TOO_LONG, // Destination C buffer cannot fit UTF-8 + trailing '\0' +}; + +struct HStrErr { + HStrErrKind kind; + int index; // Codepoint index in the source HVM list. + int bytes; // Current/required UTF-8 bytes in destination buffer. + u64 cp; // Offending codepoint for HSTR_BAD_CP. +}; + + +// Small helper to fill an error struct only when caller asked for diagnostics. +fn void hstr_set(HStrErr *err, HStrErrKind kind, int index, int bytes, u64 cp) { + if (err == NULL) { + return; + } + err->kind = kind; + err->index = index; + err->bytes = bytes; + err->cp = cp; +} + +// Encode one UTF-32 codepoint into UTF-8 bytes. +// Returns 1..4 on success, -1 on invalid scalar value. +fn int utf8_encode_scalar(u32 cp, char out[4]) { + if (cp <= 0x7F) { + out[0] = (char)cp; + return 1; + } + + if (cp <= 0x7FF) { + out[0] = (char)(0xC0 | (cp >> 6)); + out[1] = (char)(0x80 | (cp & 0x3F)); + return 2; + } + + if (cp >= 0xD800 && cp <= 0xDFFF) { + return -1; + } + + if (cp <= 0xFFFF) { + out[0] = (char)(0xE0 | (cp >> 12)); + out[1] = (char)(0x80 | ((cp >> 6) & 0x3F)); + out[2] = (char)(0x80 | (cp & 0x3F)); + return 3; + } + + if (cp <= 0x10FFFF) { + out[0] = (char)(0xF0 | (cp >> 18)); + out[1] = (char)(0x80 | ((cp >> 12) & 0x3F)); + out[2] = (char)(0x80 | ((cp >> 6) & 0x3F)); + out[3] = (char)(0x80 | (cp & 0x3F)); + return 4; + } + + return -1; +} + +// Decode one UTF-8 codepoint from a NUL-terminated C string at byte index `*idx`. +// Returns: 0=end of string, 1..4=bytes consumed, -1=invalid/truncated sequence. +fn int utf8_decode_next_cstr(const char *s, u32 *idx, u32 *cp) { + const u8 *p = (const u8 *)s + *idx; + u8 b0 = p[0]; + + if (b0 == 0) { + return 0; + } + + if (b0 < 0x80) { + *cp = b0; + *idx = *idx + 1; + return 1; + } + + if ((b0 & 0xE0) == 0xC0) { + u8 b1 = p[1]; + if (b1 == 0 || (b1 & 0xC0) != 0x80) { + return -1; + } + u32 x = ((u32)(b0 & 0x1F) << 6) | (u32)(b1 & 0x3F); + if (x < 0x80) { + return -1; + } + *cp = x; + *idx = *idx + 2; + return 2; + } + + if ((b0 & 0xF0) == 0xE0) { + u8 b1 = p[1]; + if (b1 == 0 || (b1 & 0xC0) != 0x80) { + return -1; + } + u8 b2 = p[2]; + if (b2 == 0 || (b2 & 0xC0) != 0x80) { + return -1; + } + u32 x = ((u32)(b0 & 0x0F) << 12) + | ((u32)(b1 & 0x3F) << 6) + | ((u32)(b2 & 0x3F)); + if (x < 0x800 || (x >= 0xD800 && x <= 0xDFFF)) { + return -1; + } + *cp = x; + *idx = *idx + 3; + return 3; + } + + if ((b0 & 0xF8) == 0xF0) { + u8 b1 = p[1]; + if (b1 == 0 || (b1 & 0xC0) != 0x80) { + return -1; + } + u8 b2 = p[2]; + if (b2 == 0 || (b2 & 0xC0) != 0x80) { + return -1; + } + u8 b3 = p[3]; + if (b3 == 0 || (b3 & 0xC0) != 0x80) { + return -1; + } + u32 x = ((u32)(b0 & 0x07) << 18) + | ((u32)(b1 & 0x3F) << 12) + | ((u32)(b2 & 0x3F) << 6) + | ((u32)(b3 & 0x3F)); + if (x < 0x10000 || x > 0x10FFFF) { + return -1; + } + *cp = x; + *idx = *idx + 4; + return 4; + } + + return -1; +} + +// Build #CHR{NUM} from a UTF-32 scalar. +// Returns 1 on success, 0 if scalar is invalid. +fn int term_chr_from_scalar(u32 cp, Term *out) { + if (cp > 0x10FFFF) { + return 0; + } + + if (cp >= 0xD800 && cp <= 0xDFFF) { + return 0; + } + + Term num = term_new_num(cp); + *out = term_new_ctr(NAM_CHR, 1, &num); + return 1; +} + +// NOTE: Assumes `s` is a NUL-terminated UTF-8 C string. +fn Term term_string_from_utf8(const char *s) { + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term out = nil; + Term cur = nil; + u32 idx = 0; + u8 has_node = 0; + + while (1) { + u32 cp = 0; + int n = utf8_decode_next_cstr(s, &idx, &cp); + if (n == 0) { + break; + } + if (n < 0) { + // Replace one invalid byte with U+FFFD and move forward. + cp = 0xFFFD; + idx = idx + 1; + } + + Term chr; + if (!term_chr_from_scalar(cp, &chr)) { + Term repl; + term_chr_from_scalar(0xFFFD, &repl); + chr = repl; + } + + Term args[2] = {chr, nil}; + Term node = term_new_ctr(NAM_CON, 2, args); + + if (!has_node) { + out = node; + has_node = 1; + } else { + heap_set(term_val(cur) + 1, node); + } + cur = node; + } + + return out; +} + +// Format with libc and convert the resulting UTF-8 C string to HVM String. +// On failure, returns sentinel strings like "" or "". +fn Term term_string_vprintf(const char *fmt, va_list ap) { + // First pass asks libc for the exact byte count (without NUL). + va_list ap_len; + va_copy(ap_len, ap); + int need = vsnprintf(NULL, 0, fmt, ap_len); + va_end(ap_len); + + if (need < 0) { + return term_string_from_utf8(""); + } + + size_t cap = (size_t)need + 1; + char *buf = malloc(cap); + if (buf == NULL) { + return term_string_from_utf8(""); + } + + // Second pass emits the formatted UTF-8 bytes, then we decode to HVM #CHR list. + va_list ap_fmt; + va_copy(ap_fmt, ap); + int got = vsnprintf(buf, cap, fmt, ap_fmt); + va_end(ap_fmt); + + if (got < 0 || (size_t)got >= cap) { + free(buf); + return term_string_from_utf8(""); + } + + Term out = term_string_from_utf8(buf); + free(buf); + return out; +} + +// Variadic wrapper over `term_string_vprintf`. +fn Term term_string_printf(const char *fmt, ...) { + va_list ap; + va_start(ap, fmt); + Term out = term_string_vprintf(fmt, ap); + va_end(ap); + return out; +} + +// Decode an HVM String into a NUL-terminated UTF-8 C string. +// +// src: #NIL or #CON(#CHR{NUM}, tail). +// dst: ptr to destinatation c string +// cap: max size of `dst` includes space for the trailing '\0'. +// out_len: final size of dst +// err: ptr to HStrErr to keep error information +// +// Returns 1 on success. +// Returns 0 on failure and fills `err` when provided. +// On failure, `dst` may be partially written. +fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err) { + // Walk the HVM list, validate each node, encode codepoints to UTF-8, append to `dst`. + int len = 0; // UTF-8 bytes already written to dst (without trailing '\0') + int i = 0; // Codepoint index in the HVM string, for error printing + Term cur = wnf(src); // Current list node while traversing `src` + + if (dst == NULL || cap <= 0) { + hstr_set(err, HSTR_TOO_LONG, 0, 0, 0); + return 0; + } + + while (term_tag(cur) == C02 && len < cap) { + // wnf(cur) must be List<#CHR{c}> + if (term_ext(cur) != NAM_CON) { + hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); + return 0; + } + + Term loc = term_val(cur); + Term head = wnf(heap_read(loc + 0)); + Term tail = heap_read(loc + 1); + + // wnf(head) must be #CHR{c} + if (term_tag(head) != C01 || term_ext(head) != NAM_CHR) { + hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); + return 0; + } + + // c must be NUM + Term c = wnf(heap_read(term_val(head))); + if (term_tag(c) != NUM) { + hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); + return 0; + } + + u32 cp = term_val(c); // UTF-32 scalar stored in #CHR{NUM} + char cp_utf8[4]; + int n = utf8_encode_scalar(cp, cp_utf8); + if (n < 0) { + hstr_set(err, HSTR_BAD_CP, i, len, cp); + return 0; + } + if (len + n >= cap) { + hstr_set(err, HSTR_TOO_LONG, i, len + n, cp); + return 0; + } + memcpy(dst + len, cp_utf8, n); + len += n; + i += 1; + + cur = wnf(tail); + } + + if (len >= cap) { + hstr_set(err, HSTR_TOO_LONG, i, len, 0); + return 0; + } + if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); + return 0; + } + + dst[len] = '\0'; + if (out_len != NULL) { + *out_len = len; + } + hstr_set(err, HSTR_OK, i, len, 0); + return 1; +} + +// Convert a decoding error into #ERR{String}. +// Prefix is "ERROR(): " when `prim` is non-empty, else "ERROR: ". +fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err) { + int has_prim = prim != NULL && prim[0] != '\0'; // Whether to include primitive function name in prefix + if (arg == NULL || arg[0] == '\0') { + arg = "arg"; + } + + char prefix[256]; // Shared prefix reused by all error message variants + if (has_prim) { + // If prefix formatting fails/overflows, fall back to generic prefix. + int n = snprintf(prefix, sizeof(prefix), "ERROR(%s): ", prim); + if (n < 0 || n >= (int)sizeof(prefix)) { + snprintf(prefix, sizeof(prefix), "ERROR: "); + } + } else { + snprintf(prefix, sizeof(prefix), "ERROR: "); + } + + Term msg; // Message payload for #ERR + switch (err.kind) { + case HSTR_BAD_SHAPE: + msg = term_string_printf("%sinvalid `%s`; expected #NIL or #CON(#CHR{NUM}, tail)", prefix, arg); + break; + case HSTR_BAD_CP: + msg = term_string_printf("%sinvalid UTF-32 codepoint U+%08llX at `%s` index %i", + prefix, (unsigned long long)err.cp, arg, err.index); + break; + case HSTR_TOO_LONG: + msg = term_string_printf("%s`%s` too long at index %i: %i UTF-8 bytes (max %i incl. NUL)", + prefix, arg, err.index, err.bytes, cap); + break; + default: + msg = term_string_printf("%sinvalid `%s`", prefix, arg); + break; + } + return term_new_ctr(NAM_ERR, 1, &msg); +} From 574df7dff0b4837b20384c4b6d7fa0408c824e98 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 16:55:12 +0400 Subject: [PATCH 02/35] small refactor --- clang/prim/fn/read_file.c | 147 +++++++++--------------------------- clang/prim/fn/write_bytes.c | 12 +-- clang/prim/string.c | 133 ++++++++++++++++++++++---------- 3 files changed, 130 insertions(+), 162 deletions(-) diff --git a/clang/prim/fn/read_file.c b/clang/prim/fn/read_file.c index e7428992..fb383b87 100644 --- a/clang/prim/fn/read_file.c +++ b/clang/prim/fn/read_file.c @@ -5,79 +5,7 @@ fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); fn Term term_string_printf(const char *fmt, ...); - -fn int utf8_expected_len(u8 b0) { - if (b0 < 0x80) { - return 1; - } - if ((b0 & 0xE0) == 0xC0) { - return 2; - } - if ((b0 & 0xF0) == 0xE0) { - return 3; - } - if ((b0 & 0xF8) == 0xF0) { - return 4; - } - return -1; -} - -fn int utf8_decode_seq(const u8 seq[4], int n, u32 *cp) { - u8 b0 = seq[0]; - if (n == 1) { - *cp = b0; - return 1; - } - - if (n == 2) { - u8 b1 = seq[1]; - if ((b1 & 0xC0) != 0x80) { - return 0; - } - u32 x = ((u32)(b0 & 0x1F) << 6) | (u32)(b1 & 0x3F); - if (x < 0x80) { - return 0; - } - *cp = x; - return 1; - } - - if (n == 3) { - u8 b1 = seq[1]; - u8 b2 = seq[2]; - if ((b1 & 0xC0) != 0x80 || (b2 & 0xC0) != 0x80) { - return 0; - } - u32 x = ((u32)(b0 & 0x0F) << 12) - | ((u32)(b1 & 0x3F) << 6) - | ((u32)(b2 & 0x3F)); - if (x < 0x800 || (x >= 0xD800 && x <= 0xDFFF)) { - return 0; - } - *cp = x; - return 1; - } - - if (n == 4) { - u8 b1 = seq[1]; - u8 b2 = seq[2]; - u8 b3 = seq[3]; - if ((b1 & 0xC0) != 0x80 || (b2 & 0xC0) != 0x80 || (b3 & 0xC0) != 0x80) { - return 0; - } - u32 x = ((u32)(b0 & 0x07) << 18) - | ((u32)(b1 & 0x3F) << 12) - | ((u32)(b2 & 0x3F) << 6) - | ((u32)(b3 & 0x3F)); - if (x < 0x10000 || x > 0x10FFFF) { - return 0; - } - *cp = x; - return 1; - } - - return 0; -} +fn int utf8_decode_next_bytes(const u8 *s, u32 len, u32 *idx, u32 *cp); // %read_file(path) // ---------------- @@ -108,57 +36,50 @@ fn Term prim_fn_read_file(Term *args) { u8 has_node = 0; // Incremental UTF-8 decoder state. + // `seq` stores bytes of the current candidate codepoint. u8 seq[4]; int seq_len = 0; - int seq_need = 0; int byte_i = 0; u8 b; while (fread(&b, 1, 1, file) == 1) { - if (seq_len == 0) { - seq[0] = b; - seq_len = 1; - seq_need = utf8_expected_len(b); - if (seq_need < 0) { - fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, byte_i) }); - } - } else { - // Continuation bytes must start with bits `10`. - if ((b & 0xC0) != 0x80) { - int seq_start = byte_i - seq_len; - fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); - } - seq[seq_len] = b; - seq_len += 1; + if (seq_len >= 4) { + int seq_start = byte_i - seq_len; + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); + } + seq[seq_len] = b; + seq_len += 1; + + // Try to decode the current sequence from byte slice (not NUL-terminated). + u32 seq_idx = 0; + u32 cp = 0; + int dec = utf8_decode_next_bytes(seq, (u32)seq_len, &seq_idx, &cp); + if (dec == -2) { + // Need more bytes for the current codepoint. + byte_i += 1; + continue; + } + if (dec < 0) { + int seq_start = byte_i - (seq_len - 1); + fclose(file); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); } - if (seq_len == seq_need) { - u32 cp = 0; - if (!utf8_decode_seq(seq, seq_need, &cp)) { - int seq_start = byte_i - (seq_need - 1); - fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); - } - - Term num = term_new_num(cp); - Term chr = term_new_ctr(NAM_CHR, 1, &num); - Term h_t[2] = {chr, Nil}; - Term node = term_new_ctr(NAM_CON, 2, h_t); - - if (!has_node) { - result = node; - has_node = 1; - } else { - heap_set(term_val(curr) + 1, node); - } - curr = node; + Term num = term_new_num(cp); + Term chr = term_new_ctr(NAM_CHR, 1, &num); + Term h_t[2] = {chr, Nil}; + Term node = term_new_ctr(NAM_CON, 2, h_t); - seq_len = 0; - seq_need = 0; + if (!has_node) { + result = node; + has_node = 1; + } else { + heap_set(term_val(curr) + 1, node); } + curr = node; + seq_len = 0; byte_i += 1; } diff --git a/clang/prim/fn/write_bytes.c b/clang/prim/fn/write_bytes.c index 46e0c73e..da5f4b89 100644 --- a/clang/prim/fn/write_bytes.c +++ b/clang/prim/fn/write_bytes.c @@ -39,8 +39,7 @@ fn Term prim_fn_write_bytes(Term *args) { // wnf(data_item) must be List<#BYT{b}> if (term_ext(data_item) != NAM_CON) { fclose(file); - Term msg = term_string_printf("%s", DATA_EXPECTED); - return term_new_ctr(NAM_ERR, 1, &msg); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } Term head_loc = term_val(data_item); @@ -51,8 +50,7 @@ fn Term prim_fn_write_bytes(Term *args) { // wnf(head) must be #BYT{b} if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { fclose(file); - Term msg = term_string_printf("%s", DATA_EXPECTED); - return term_new_ctr(NAM_ERR, 1, &msg); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } Term b_loc = term_val(head); @@ -62,8 +60,7 @@ fn Term prim_fn_write_bytes(Term *args) { // b in #BYT{b} must be NUM if (term_tag(b_trm) != NUM) { fclose(file); - Term msg = term_string_printf("%s", DATA_EXPECTED); - return term_new_ctr(NAM_ERR, 1, &msg); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } // NUM must fit one byte. @@ -88,8 +85,7 @@ fn Term prim_fn_write_bytes(Term *args) { if (term_tag(data_item) != C00 || term_ext(data_item) != NAM_NIL) { fclose(file); - Term msg = term_string_printf("%s", DATA_EXPECTED); - return term_new_ctr(NAM_ERR, 1, &msg); + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } if (fflush(file) != 0) { diff --git a/clang/prim/string.c b/clang/prim/string.c index df65680d..b7e3debc 100644 --- a/clang/prim/string.c +++ b/clang/prim/string.c @@ -8,6 +8,7 @@ typedef struct HStrErr HStrErr; // UTF-8 helpers fn int utf8_encode_scalar(u32 cp, char out[4]); +fn int utf8_decode_next_bytes(const u8 *s, u32 len, u32 *idx, u32 *cp); fn int utf8_decode_next_cstr(const char *s, u32 *idx, u32 *cp); // Term <-> c string, conversion helpers @@ -20,6 +21,8 @@ fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HSt // Local utility fn void hstr_set(HStrErr *err, HStrErrKind kind, int index, int bytes, u64 cp); +fn int utf8_seq_expected_len(u8 b0); +fn int utf8_decode_seq(const u8 *p, int n, u32 *cp); enum HStrErrKind { HSTR_OK = 0, @@ -83,82 +86,130 @@ fn int utf8_encode_scalar(u32 cp, char out[4]) { return -1; } -// Decode one UTF-8 codepoint from a NUL-terminated C string at byte index `*idx`. -// Returns: 0=end of string, 1..4=bytes consumed, -1=invalid/truncated sequence. -fn int utf8_decode_next_cstr(const char *s, u32 *idx, u32 *cp) { - const u8 *p = (const u8 *)s + *idx; - u8 b0 = p[0]; - - if (b0 == 0) { - return 0; +// Get UTF-8 sequence length from the first byte. +// Returns 1..4 on valid leading byte, -1 otherwise. +fn int utf8_seq_expected_len(u8 b0) { + if (b0 < 0x80) { + return 1; } + if ((b0 & 0xE0) == 0xC0) { + return 2; + } + if ((b0 & 0xF0) == 0xE0) { + return 3; + } + if ((b0 & 0xF8) == 0xF0) { + return 4; + } + return -1; +} - if (b0 < 0x80) { - *cp = b0; - *idx = *idx + 1; +// Decode exactly one UTF-8 sequence from `p[0..n-1]`. +// Returns 1 on success, 0 on invalid encoding. +fn int utf8_decode_seq(const u8 *p, int n, u32 *cp) { + u8 b0 = p[0]; + + if (n == 1) { + *cp = b0; return 1; } - if ((b0 & 0xE0) == 0xC0) { + if (n == 2) { u8 b1 = p[1]; - if (b1 == 0 || (b1 & 0xC0) != 0x80) { - return -1; + if ((b1 & 0xC0) != 0x80) { + return 0; } u32 x = ((u32)(b0 & 0x1F) << 6) | (u32)(b1 & 0x3F); if (x < 0x80) { - return -1; + return 0; } - *cp = x; - *idx = *idx + 2; - return 2; + *cp = x; + return 1; } - if ((b0 & 0xF0) == 0xE0) { + if (n == 3) { u8 b1 = p[1]; - if (b1 == 0 || (b1 & 0xC0) != 0x80) { - return -1; - } u8 b2 = p[2]; - if (b2 == 0 || (b2 & 0xC0) != 0x80) { - return -1; + if ((b1 & 0xC0) != 0x80 || (b2 & 0xC0) != 0x80) { + return 0; } u32 x = ((u32)(b0 & 0x0F) << 12) | ((u32)(b1 & 0x3F) << 6) | ((u32)(b2 & 0x3F)); if (x < 0x800 || (x >= 0xD800 && x <= 0xDFFF)) { - return -1; + return 0; } - *cp = x; - *idx = *idx + 3; - return 3; + *cp = x; + return 1; } - if ((b0 & 0xF8) == 0xF0) { + if (n == 4) { u8 b1 = p[1]; - if (b1 == 0 || (b1 & 0xC0) != 0x80) { - return -1; - } u8 b2 = p[2]; - if (b2 == 0 || (b2 & 0xC0) != 0x80) { - return -1; - } u8 b3 = p[3]; - if (b3 == 0 || (b3 & 0xC0) != 0x80) { - return -1; + if ((b1 & 0xC0) != 0x80 || (b2 & 0xC0) != 0x80 || (b3 & 0xC0) != 0x80) { + return 0; } u32 x = ((u32)(b0 & 0x07) << 18) | ((u32)(b1 & 0x3F) << 12) | ((u32)(b2 & 0x3F) << 6) | ((u32)(b3 & 0x3F)); if (x < 0x10000 || x > 0x10FFFF) { + return 0; + } + *cp = x; + return 1; + } + + return 0; +} + +// Decode one UTF-8 codepoint from a byte slice `s[0..len-1]` at byte index `*idx`. +// Returns: 0=end of slice, 1..4=bytes consumed, -1=invalid sequence, -2=truncated sequence. +fn int utf8_decode_next_bytes(const u8 *s, u32 len, u32 *idx, u32 *cp) { + if (*idx >= len) { + return 0; + } + + u32 i = *idx; + int n = utf8_seq_expected_len(s[i]); + if (n < 0) { + return -1; + } + if (i + (u32)n > len) { + return -2; + } + if (!utf8_decode_seq(s + i, n, cp)) { + return -1; + } + + *idx = i + (u32)n; + return n; +} + +// Decode one UTF-8 codepoint from a NUL-terminated C string at byte index `*idx`. +// Returns: 0=end of string, 1..4=bytes consumed, -1=invalid/truncated sequence. +fn int utf8_decode_next_cstr(const char *s, u32 *idx, u32 *cp) { + const u8 *p = (const u8 *)s + *idx; + if (p[0] == 0) { + return 0; + } + + int n = utf8_seq_expected_len(p[0]); + if (n < 0) { + return -1; + } + for (int j = 1; j < n; ++j) { + if (p[j] == 0) { return -1; } - *cp = x; - *idx = *idx + 4; - return 4; + } + if (!utf8_decode_seq(p, n, cp)) { + return -1; } - return -1; + *idx = *idx + (u32)n; + return n; } // Build #CHR{NUM} from a UTF-32 scalar. From b4802fef4c387768616fecedbe507d7f3cb0f137 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 18:50:21 +0400 Subject: [PATCH 03/35] lread_file that properly handles SUP,INC,ERA --- clang/prim/fn/log.c | 2 +- clang/prim/fn/lread_file.c | 266 +++++++++++++++++++++++++++++++++++++ clang/prim/init.c | 1 + 3 files changed, 268 insertions(+), 1 deletion(-) create mode 100644 clang/prim/fn/lread_file.c diff --git a/clang/prim/fn/log.c b/clang/prim/fn/log.c index c3b28e8e..67291b12 100644 --- a/clang/prim/fn/log.c +++ b/clang/prim/fn/log.c @@ -5,7 +5,7 @@ fn Term prim_fn_log_go_2(Term *args); // %log(s) // ---------------- log -// %log_go_0([], s) +// %log_go_0(λx.x, s) fn Term prim_fn_log(Term *args) { u64 loc = heap_alloc(1); Term var = term_new_var(loc); diff --git a/clang/prim/fn/lread_file.c b/clang/prim/fn/lread_file.c new file mode 100644 index 00000000..0217be3e --- /dev/null +++ b/clang/prim/fn/lread_file.c @@ -0,0 +1,266 @@ +#include + +fn Term wnf(Term term); + +fn Term lread_file_go_0(Term *args); +fn Term lread_file_go_1(Term *args); +fn Term lread_file_go_2(Term *args); + +// Call strict %read_file(path). +fn Term lread_file_call_read_file(Term path) { + Term args0[1] = {path}; + Term t = term_new_pri(table_find("read_file", 9), 1, args0); + return wnf(t); +} + +// %lread_file(path) +// ----------------- +// %lread_file_go_0(λx.x, path) +fn Term prim_fn_lread_file(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("lread_file_go_0", 15), 2, args0); + return wnf(t); +} + +fn Term lread_file_go_call(Term acc, Term list) { + Term path = term_new_app(acc, list); + return lread_file_call_read_file(path); +} + +// %lread_file_go_0(acc, list) +// --------------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term lread_file_go_0(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %lread_file_go_0(acc, &{}) + // -------------------------- lread-file-go-0-era + // &{} + return term_new_era(); + } + case INC: { + // %lread_file_go_0(acc, ↑x) + // ------------------------- lread-file-go-0-inc + // ↑(%lread_file(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("lread_file", 10), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %lread_file_go_0(acc, &L{x,y}) + // ------------------------------ lread-file-go-0-sup + // &L{%lread_file(acc0(x)), %lread_file(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("lread_file", 10), 1, &app0); + Term t1 = term_new_pri(table_find("lread_file", 10), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %lread_file_go_0(acc, #Nil) + // ---------------------------- lread-file-go-0-nil + // %read_file(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + return lread_file_go_call(acc, nil); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %lread_file_go_0(acc, #Con{h,t}) + // --------------------------------- lread-file-go-0-con + // %lread_file_go_1(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("lread_file_go_1", 15), 3, args0); + return wnf(t); + } + // %lread_file_go_0(acc, x) + // ------------------------- lread-file-go-0-fallback + // %read_file(acc(x)) + return lread_file_go_call(acc, list_wnf); + } + default: { + // %lread_file_go_0(acc, x) + // ------------------------- lread-file-go-0-default + // %read_file(acc(x)) + return lread_file_go_call(acc, list_wnf); + } + } +} + +// %lread_file_go_1(acc, head, tail) +// --------------------------------- +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term lread_file_go_1(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %lread_file_go_1(acc, &{}, t) + // ----------------------------- lread-file-go-1-era + // &{} + return term_new_era(); + } + case INC: { + // %lread_file_go_1(acc, ↑x, t) + // ------------------------------ lread-file-go-1-inc + // ↑(%lread_file(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("lread_file", 10), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %lread_file_go_1(acc, &L{x,y}, t) + // --------------------------------- lread-file-go-1-sup + // &L{%lread_file(acc0(#Con{x, t0})), %lread_file(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("lread_file", 10), 1, &app0); + Term t1 = term_new_pri(table_find("lread_file", 10), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %lread_file_go_1(acc, #Chr{c}, t) + // ---------------------------------- lread-file-go-1-chr + // %lread_file_go_2(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("lread_file_go_2", 15), 3, args0); + return wnf(t); + } + // %lread_file_go_1(acc, h, t) + // ---------------------------- lread-file-go-1-fallback + // %read_file(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + return lread_file_go_call(acc, con); + } + default: { + // %lread_file_go_1(acc, h, t) + // ---------------------------- lread-file-go-1-default + // %read_file(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + return lread_file_go_call(acc, con); + } + } +} + +// %lread_file_go_2(acc, code, tail) +// --------------------------------- +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term lread_file_go_2(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %lread_file_go_2(acc, &{}, t) + // ----------------------------- lread-file-go-2-era + // &{} + return term_new_era(); + } + case INC: { + // %lread_file_go_2(acc, ↑x, t) + // ------------------------------ lread-file-go-2-inc + // ↑(%lread_file(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("lread_file", 10), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %lread_file_go_2(acc, &L{x,y}, t) + // --------------------------------- lread-file-go-2-sup + // &L{%lread_file(acc0(#Con{#Chr{x}, t0})), %lread_file(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("lread_file", 10), 1, &app0); + Term t1 = term_new_pri(table_find("lread_file", 10), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %lread_file_go_2(acc, n, t) + // ----------------------------- lread-file-go-2-num + // %lread_file_go_0(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("lread_file_go_0", 15), 2, args0); + return wnf(t); + } + default: { + // %lread_file_go_2(acc, c, t) + // ---------------------------- lread-file-go-2-default + // %read_file(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + return lread_file_go_call(acc, con); + } + } +} + +fn void prim_lread_file_init(void) { + prim_register("lread_file", 10, 1, prim_fn_lread_file); + prim_register("lread_file_go_0", 15, 2, lread_file_go_0); + prim_register("lread_file_go_1", 15, 3, lread_file_go_1); + prim_register("lread_file_go_2", 15, 3, lread_file_go_2); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 22315b4e..e8cccd5b 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -5,5 +5,6 @@ fn void prim_init(void) { prim_read_bytes_init(); prim_write_bytes_init(); prim_read_file_init(); + prim_lread_file_init(); prim_write_file_init(); } From 01660f2979cbbb410fc09569d91a813799ec82fe Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 18:55:30 +0400 Subject: [PATCH 04/35] fix bug in log: now can handle %log(&L{'a','b'}<>[]) --- clang/prim/fn/log_go_1.c | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/clang/prim/fn/log_go_1.c b/clang/prim/fn/log_go_1.c index eed8f065..ea6afe34 100644 --- a/clang/prim/fn/log_go_1.c +++ b/clang/prim/fn/log_go_1.c @@ -16,11 +16,10 @@ fn Term prim_fn_log_go_1(Term *args) { case INC: { // %log_go_1(acc, ↑x, t) // --------------------- log-go-1-inc - // ↑(%log(acc(#Con{#Chr{x}, t}))) + // ↑(%log(acc(#Con{x, t}))) u64 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(SYM_CHR, 1, &inner); - Term con_args[2] = {chr, tail}; + Term con_args[2] = {inner, tail}; Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term log = term_new_pri(table_find("log", 3), 1, &app); @@ -30,17 +29,15 @@ fn Term prim_fn_log_go_1(Term *args) { case SUP: { // %log_go_1(acc, &L{x,y}, t) // -------------------------- log-go-1-sup - // &L{%log(acc0(#Con{#Chr{x}, t0})), %log(acc1(#Con{#Chr{y}, t1}))} + // &L{%log(acc0(#Con{x, t0})), %log(acc1(#Con{y, t1}))} u32 lab = term_ext(head_wnf); u64 sup_loc = term_val(head_wnf); Term x = heap_read(sup_loc + 0); Term y = heap_read(sup_loc + 1); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(SYM_CHR, 1, &x); - Term chr1 = term_new_ctr(SYM_CHR, 1, &y); - Term con0_args[2] = {chr0, T.k0}; - Term con1_args[2] = {chr1, T.k1}; + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; Term con0 = term_new_ctr(SYM_CON, 2, con0_args); Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); From 04ea4248cbe0a742680e7ba63b8fe88c666a67e8 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 19:29:12 +0400 Subject: [PATCH 05/35] prim refactor --- clang/prim/fn/lread_file.c | 266 ---------------------------------- clang/prim/fn/read_file.c | 10 +- clang/prim/fn/read_file_go.c | 274 +++++++++++++++++++++++++++++++++++ clang/prim/init.c | 1 - 4 files changed, 277 insertions(+), 274 deletions(-) delete mode 100644 clang/prim/fn/lread_file.c create mode 100644 clang/prim/fn/read_file_go.c diff --git a/clang/prim/fn/lread_file.c b/clang/prim/fn/lread_file.c deleted file mode 100644 index 0217be3e..00000000 --- a/clang/prim/fn/lread_file.c +++ /dev/null @@ -1,266 +0,0 @@ -#include - -fn Term wnf(Term term); - -fn Term lread_file_go_0(Term *args); -fn Term lread_file_go_1(Term *args); -fn Term lread_file_go_2(Term *args); - -// Call strict %read_file(path). -fn Term lread_file_call_read_file(Term path) { - Term args0[1] = {path}; - Term t = term_new_pri(table_find("read_file", 9), 1, args0); - return wnf(t); -} - -// %lread_file(path) -// ----------------- -// %lread_file_go_0(λx.x, path) -fn Term prim_fn_lread_file(Term *args) { - u64 loc = heap_alloc(1); - Term var = term_new_var(loc); - Term acc = term_new_lam_at(loc, var); - Term args0[2] = {acc, args[0]}; - Term t = term_new_pri(table_find("lread_file_go_0", 15), 2, args0); - return wnf(t); -} - -fn Term lread_file_go_call(Term acc, Term list) { - Term path = term_new_app(acc, list); - return lread_file_call_read_file(path); -} - -// %lread_file_go_0(acc, list) -// --------------------------- -// Walk list shape with lifting over ERA/INC/SUP. -fn Term lread_file_go_0(Term *args) { - Term acc = args[0]; - Term list_wnf = wnf(args[1]); - - switch (term_tag(list_wnf)) { - case ERA: { - // %lread_file_go_0(acc, &{}) - // -------------------------- lread-file-go-0-era - // &{} - return term_new_era(); - } - case INC: { - // %lread_file_go_0(acc, ↑x) - // ------------------------- lread-file-go-0-inc - // ↑(%lread_file(acc(x))) - u32 inc_loc = term_val(list_wnf); - Term inner = heap_read(inc_loc); - Term app = term_new_app(acc, inner); - Term next = term_new_pri(table_find("lread_file", 10), 1, &app); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %lread_file_go_0(acc, &L{x,y}) - // ------------------------------ lread-file-go-0-sup - // &L{%lread_file(acc0(x)), %lread_file(acc1(y))} - u32 lab = term_ext(list_wnf); - u32 sup_loc = term_val(list_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Copy A = term_clone(lab, acc); - Term app0 = term_new_app(A.k0, x); - Term app1 = term_new_app(A.k1, y); - Term t0 = term_new_pri(table_find("lread_file", 10), 1, &app0); - Term t1 = term_new_pri(table_find("lread_file", 10), 1, &app1); - return term_new_sup(lab, t0, t1); - } - case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { - // %lread_file_go_0(acc, #Nil) - // ---------------------------- lread-file-go-0-nil - // %read_file(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); - return lread_file_go_call(acc, nil); - } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { - // %lread_file_go_0(acc, #Con{h,t}) - // --------------------------------- lread-file-go-0-con - // %lread_file_go_1(acc, h, t) - u32 con_loc = term_val(list_wnf); - Term head = heap_read(con_loc + 0); - Term tail = heap_read(con_loc + 1); - Term args0[3] = {acc, head, tail}; - Term t = term_new_pri(table_find("lread_file_go_1", 15), 3, args0); - return wnf(t); - } - // %lread_file_go_0(acc, x) - // ------------------------- lread-file-go-0-fallback - // %read_file(acc(x)) - return lread_file_go_call(acc, list_wnf); - } - default: { - // %lread_file_go_0(acc, x) - // ------------------------- lread-file-go-0-default - // %read_file(acc(x)) - return lread_file_go_call(acc, list_wnf); - } - } -} - -// %lread_file_go_1(acc, head, tail) -// --------------------------------- -// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. -fn Term lread_file_go_1(Term *args) { - Term acc = args[0]; - Term head_wnf = wnf(args[1]); - Term tail = args[2]; - - switch (term_tag(head_wnf)) { - case ERA: { - // %lread_file_go_1(acc, &{}, t) - // ----------------------------- lread-file-go-1-era - // &{} - return term_new_era(); - } - case INC: { - // %lread_file_go_1(acc, ↑x, t) - // ------------------------------ lread-file-go-1-inc - // ↑(%lread_file(acc(#Con{x, t}))) - u32 inc_loc = term_val(head_wnf); - Term inner = heap_read(inc_loc); - Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term app = term_new_app(acc, con); - Term next = term_new_pri(table_find("lread_file", 10), 1, &app); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %lread_file_go_1(acc, &L{x,y}, t) - // --------------------------------- lread-file-go-1-sup - // &L{%lread_file(acc0(#Con{x, t0})), %lread_file(acc1(#Con{y, t1}))} - u32 lab = term_ext(head_wnf); - u32 sup_loc = term_val(head_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Copy A = term_clone(lab, acc); - Copy T = term_clone(lab, tail); - Term con0_args[2] = {x, T.k0}; - Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); - Term app0 = term_new_app(A.k0, con0); - Term app1 = term_new_app(A.k1, con1); - Term t0 = term_new_pri(table_find("lread_file", 10), 1, &app0); - Term t1 = term_new_pri(table_find("lread_file", 10), 1, &app1); - return term_new_sup(lab, t0, t1); - } - case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { - // %lread_file_go_1(acc, #Chr{c}, t) - // ---------------------------------- lread-file-go-1-chr - // %lread_file_go_2(acc, c, t) - u32 chr_loc = term_val(head_wnf); - Term code = heap_read(chr_loc + 0); - Term args0[3] = {acc, code, tail}; - Term t = term_new_pri(table_find("lread_file_go_2", 15), 3, args0); - return wnf(t); - } - // %lread_file_go_1(acc, h, t) - // ---------------------------- lread-file-go-1-fallback - // %read_file(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - return lread_file_go_call(acc, con); - } - default: { - // %lread_file_go_1(acc, h, t) - // ---------------------------- lread-file-go-1-default - // %read_file(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - return lread_file_go_call(acc, con); - } - } -} - -// %lread_file_go_2(acc, code, tail) -// --------------------------------- -// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. -fn Term lread_file_go_2(Term *args) { - Term acc = args[0]; - Term code_wnf = wnf(args[1]); - Term tail = args[2]; - - switch (term_tag(code_wnf)) { - case ERA: { - // %lread_file_go_2(acc, &{}, t) - // ----------------------------- lread-file-go-2-era - // &{} - return term_new_era(); - } - case INC: { - // %lread_file_go_2(acc, ↑x, t) - // ------------------------------ lread-file-go-2-inc - // ↑(%lread_file(acc(#Con{#Chr{x}, t}))) - u32 inc_loc = term_val(code_wnf); - Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); - Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term app = term_new_app(acc, con); - Term next = term_new_pri(table_find("lread_file", 10), 1, &app); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %lread_file_go_2(acc, &L{x,y}, t) - // --------------------------------- lread-file-go-2-sup - // &L{%lread_file(acc0(#Con{#Chr{x}, t0})), %lread_file(acc1(#Con{#Chr{y}, t1}))} - u32 lab = term_ext(code_wnf); - u32 sup_loc = term_val(code_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Copy A = term_clone(lab, acc); - Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); - Term con0_args[2] = {chr0, T.k0}; - Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); - Term app0 = term_new_app(A.k0, con0); - Term app1 = term_new_app(A.k1, con1); - Term t0 = term_new_pri(table_find("lread_file", 10), 1, &app0); - Term t1 = term_new_pri(table_find("lread_file", 10), 1, &app1); - return term_new_sup(lab, t0, t1); - } - case NUM: { - // %lread_file_go_2(acc, n, t) - // ----------------------------- lread-file-go-2-num - // %lread_file_go_0(λx.acc(#Con{#Chr{n}, x}), t) - u64 loc = heap_alloc(1); - Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); - Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term bod = term_new_app(acc, con); - Term acc_next = term_new_lam_at(loc, bod); - Term args0[2] = {acc_next, tail}; - Term t = term_new_pri(table_find("lread_file_go_0", 15), 2, args0); - return wnf(t); - } - default: { - // %lread_file_go_2(acc, c, t) - // ---------------------------- lread-file-go-2-default - // %read_file(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); - Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - return lread_file_go_call(acc, con); - } - } -} - -fn void prim_lread_file_init(void) { - prim_register("lread_file", 10, 1, prim_fn_lread_file); - prim_register("lread_file_go_0", 15, 2, lread_file_go_0); - prim_register("lread_file_go_1", 15, 3, lread_file_go_1); - prim_register("lread_file_go_2", 15, 3, lread_file_go_2); -} diff --git a/clang/prim/fn/read_file.c b/clang/prim/fn/read_file.c index fb383b87..892f008b 100644 --- a/clang/prim/fn/read_file.c +++ b/clang/prim/fn/read_file.c @@ -7,10 +7,10 @@ fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HSt fn Term term_string_printf(const char *fmt, ...); fn int utf8_decode_next_bytes(const u8 *s, u32 len, u32 *idx, u32 *cp); -// %read_file(path) -// ---------------- +// %read_file_go_io(path) +// ---------------------- // #OK{List<#CHR{NUM}>} | #ERR{String} -fn Term prim_fn_read_file(Term *args) { +fn Term prim_fn_read_file_go_io(Term *args) { int MAX_PATH = 1024; char path[MAX_PATH]; // UTF-8 bytes const char *OPEN_PATH_ERR_FMT = "ERROR(read_file): failed to open path '%s': %s (errno=%d)"; @@ -99,7 +99,3 @@ fn Term prim_fn_read_file(Term *args) { fclose(file); return term_new_ctr(NAM_OK, 1, &result); } - -fn void prim_read_file_init(void) { - prim_register("read_file", 9, 1, prim_fn_read_file); -} diff --git a/clang/prim/fn/read_file_go.c b/clang/prim/fn/read_file_go.c new file mode 100644 index 00000000..1903a4cc --- /dev/null +++ b/clang/prim/fn/read_file_go.c @@ -0,0 +1,274 @@ +#include + +fn Term wnf(Term term); +fn Term prim_fn_read_file_go_io(Term *args); + +fn Term read_file_go_path(Term *args); +fn Term read_file_go_chr(Term *args); +fn Term read_file_go_num(Term *args); + +// %read_file(path) +// ----------------- +// %read_file_go_path(λx.x, path) +fn Term prim_fn_read_file(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("read_file_go_path", 17), 2, args0); + return wnf(t); +} + +// %read_file_go_path(acc, list) +// --------------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term read_file_go_path(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %read_file_go_path(acc, &{}) + // -------------------------- read-file-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %read_file_go_path(acc, ↑x) + // ------------------------- read-file-go-path-inc + // ↑(%read_file(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("read_file", 9), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_file_go_path(acc, &L{x,y}) + // ------------------------------ read-file-go-path-sup + // &L{%read_file(acc0(x)), %read_file(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); + Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %read_file_go_path(acc, #Nil) + // ---------------------------- read-file-go-path-nil + // %read_file_go_io(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term path = term_new_app(acc, nil); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %read_file_go_path(acc, #Con{h,t}) + // --------------------------------- read-file-go-path-con + // %read_file_go_chr(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("read_file_go_chr", 16), 3, args0); + return wnf(t); + } + // %read_file_go_path(acc, x) + // ------------------------- read-file-go-path-fallback + // %read_file_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + default: { + // %read_file_go_path(acc, x) + // ------------------------- read-file-go-path-default + // %read_file_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + } +} + +// %read_file_go_chr(acc, head, tail) +// --------------------------------- +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term read_file_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %read_file_go_chr(acc, &{}, t) + // ----------------------------- read-file-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %read_file_go_chr(acc, ↑x, t) + // ------------------------------ read-file-go-chr-inc + // ↑(%read_file(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("read_file", 9), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_file_go_chr(acc, &L{x,y}, t) + // --------------------------------- read-file-go-chr-sup + // &L{%read_file(acc0(#Con{x, t0})), %read_file(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); + Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %read_file_go_chr(acc, #Chr{c}, t) + // ---------------------------------- read-file-go-chr-chr + // %read_file_go_num(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("read_file_go_num", 16), 3, args0); + return wnf(t); + } + // %read_file_go_chr(acc, h, t) + // ---------------------------- read-file-go-chr-fallback + // %read_file_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + default: { + // %read_file_go_chr(acc, h, t) + // ---------------------------- read-file-go-chr-default + // %read_file_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + } +} + +// %read_file_go_num(acc, code, tail) +// --------------------------------- +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term read_file_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %read_file_go_num(acc, &{}, t) + // ----------------------------- read-file-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %read_file_go_num(acc, ↑x, t) + // ------------------------------ read-file-go-num-inc + // ↑(%read_file(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("read_file", 9), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_file_go_num(acc, &L{x,y}, t) + // --------------------------------- read-file-go-num-sup + // &L{%read_file(acc0(#Con{#Chr{x}, t0})), %read_file(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); + Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %read_file_go_num(acc, n, t) + // ----------------------------- read-file-go-num-num + // %read_file_go_path(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("read_file_go_path", 17), 2, args0); + return wnf(t); + } + default: { + // %read_file_go_num(acc, c, t) + // ---------------------------- read-file-go-num-default + // %read_file_go_io(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + } +} + +fn void prim_read_file_init(void) { + prim_register("read_file_go_io", 15, 1, prim_fn_read_file_go_io); + prim_register("read_file", 9, 1, prim_fn_read_file); + prim_register("read_file_go_path", 17, 2, read_file_go_path); + prim_register("read_file_go_chr", 16, 3, read_file_go_chr); + prim_register("read_file_go_num", 16, 3, read_file_go_num); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index e8cccd5b..22315b4e 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -5,6 +5,5 @@ fn void prim_init(void) { prim_read_bytes_init(); prim_write_bytes_init(); prim_read_file_init(); - prim_lread_file_init(); prim_write_file_init(); } From 14664622489ba19ffa822c61ca09bc1ca7308ef8 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 19:42:20 +0400 Subject: [PATCH 06/35] refactor --- clang/prim/fn/read_file.c | 277 ++++++++++++++++++++++++++++++++++- clang/prim/fn/read_file_go.c | 274 ---------------------------------- 2 files changed, 269 insertions(+), 282 deletions(-) delete mode 100644 clang/prim/fn/read_file_go.c diff --git a/clang/prim/fn/read_file.c b/clang/prim/fn/read_file.c index 892f008b..7a8dce21 100644 --- a/clang/prim/fn/read_file.c +++ b/clang/prim/fn/read_file.c @@ -1,11 +1,264 @@ -#include -#include -#include -#include -fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); -fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); -fn Term term_string_printf(const char *fmt, ...); -fn int utf8_decode_next_bytes(const u8 *s, u32 len, u32 *idx, u32 *cp); +fn Term read_file_go_path(Term *args); +fn Term read_file_go_chr(Term *args); +fn Term read_file_go_num(Term *args); + +// %read_file(path) +// ----------------- +// %read_file_go_path(λx.x, path) +fn Term prim_fn_read_file(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("read_file_go_path", 17), 2, args0); + return wnf(t); +} + +// %read_file_go_path(acc, list) +// --------------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term read_file_go_path(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %read_file_go_path(acc, &{}) + // -------------------------- read-file-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %read_file_go_path(acc, ↑x) + // ------------------------- read-file-go-path-inc + // ↑(%read_file(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("read_file", 9), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_file_go_path(acc, &L{x,y}) + // ------------------------------ read-file-go-path-sup + // &L{%read_file(acc0(x)), %read_file(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); + Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %read_file_go_path(acc, #Nil) + // ---------------------------- read-file-go-path-nil + // %read_file_go_io(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term path = term_new_app(acc, nil); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %read_file_go_path(acc, #Con{h,t}) + // --------------------------------- read-file-go-path-con + // %read_file_go_chr(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("read_file_go_chr", 16), 3, args0); + return wnf(t); + } + // %read_file_go_path(acc, x) + // ------------------------- read-file-go-path-fallback + // %read_file_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + default: { + // %read_file_go_path(acc, x) + // ------------------------- read-file-go-path-default + // %read_file_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + } +} + +// %read_file_go_chr(acc, head, tail) +// --------------------------------- +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term read_file_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %read_file_go_chr(acc, &{}, t) + // ----------------------------- read-file-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %read_file_go_chr(acc, ↑x, t) + // ------------------------------ read-file-go-chr-inc + // ↑(%read_file(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("read_file", 9), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_file_go_chr(acc, &L{x,y}, t) + // --------------------------------- read-file-go-chr-sup + // &L{%read_file(acc0(#Con{x, t0})), %read_file(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); + Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %read_file_go_chr(acc, #Chr{c}, t) + // ---------------------------------- read-file-go-chr-chr + // %read_file_go_num(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("read_file_go_num", 16), 3, args0); + return wnf(t); + } + // %read_file_go_chr(acc, h, t) + // ---------------------------- read-file-go-chr-fallback + // %read_file_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + default: { + // %read_file_go_chr(acc, h, t) + // ---------------------------- read-file-go-chr-default + // %read_file_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + } +} + +// %read_file_go_num(acc, code, tail) +// --------------------------------- +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term read_file_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %read_file_go_num(acc, &{}, t) + // ----------------------------- read-file-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %read_file_go_num(acc, ↑x, t) + // ------------------------------ read-file-go-num-inc + // ↑(%read_file(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("read_file", 9), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_file_go_num(acc, &L{x,y}, t) + // --------------------------------- read-file-go-num-sup + // &L{%read_file(acc0(#Con{#Chr{x}, t0})), %read_file(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); + Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %read_file_go_num(acc, n, t) + // ----------------------------- read-file-go-num-num + // %read_file_go_path(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("read_file_go_path", 17), 2, args0); + return wnf(t); + } + default: { + // %read_file_go_num(acc, c, t) + // ---------------------------- read-file-go-num-default + // %read_file_go_io(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); + return wnf(io); + } + } +} // %read_file_go_io(path) // ---------------------- @@ -99,3 +352,11 @@ fn Term prim_fn_read_file_go_io(Term *args) { fclose(file); return term_new_ctr(NAM_OK, 1, &result); } + +fn void prim_read_file_init(void) { + prim_register("read_file", 9, 1, prim_fn_read_file); + prim_register("read_file_go_path", 17, 2, read_file_go_path); + prim_register("read_file_go_chr", 16, 3, read_file_go_chr); + prim_register("read_file_go_num", 16, 3, read_file_go_num); + prim_register("read_file_go_io", 15, 1, prim_fn_read_file_go_io); +} diff --git a/clang/prim/fn/read_file_go.c b/clang/prim/fn/read_file_go.c deleted file mode 100644 index 1903a4cc..00000000 --- a/clang/prim/fn/read_file_go.c +++ /dev/null @@ -1,274 +0,0 @@ -#include - -fn Term wnf(Term term); -fn Term prim_fn_read_file_go_io(Term *args); - -fn Term read_file_go_path(Term *args); -fn Term read_file_go_chr(Term *args); -fn Term read_file_go_num(Term *args); - -// %read_file(path) -// ----------------- -// %read_file_go_path(λx.x, path) -fn Term prim_fn_read_file(Term *args) { - u64 loc = heap_alloc(1); - Term var = term_new_var(loc); - Term acc = term_new_lam_at(loc, var); - Term args0[2] = {acc, args[0]}; - Term t = term_new_pri(table_find("read_file_go_path", 17), 2, args0); - return wnf(t); -} - -// %read_file_go_path(acc, list) -// --------------------------- -// Walk list shape with lifting over ERA/INC/SUP. -fn Term read_file_go_path(Term *args) { - Term acc = args[0]; - Term list_wnf = wnf(args[1]); - - switch (term_tag(list_wnf)) { - case ERA: { - // %read_file_go_path(acc, &{}) - // -------------------------- read-file-go-path-era - // &{} - return term_new_era(); - } - case INC: { - // %read_file_go_path(acc, ↑x) - // ------------------------- read-file-go-path-inc - // ↑(%read_file(acc(x))) - u32 inc_loc = term_val(list_wnf); - Term inner = heap_read(inc_loc); - Term app = term_new_app(acc, inner); - Term next = term_new_pri(table_find("read_file", 9), 1, &app); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %read_file_go_path(acc, &L{x,y}) - // ------------------------------ read-file-go-path-sup - // &L{%read_file(acc0(x)), %read_file(acc1(y))} - u32 lab = term_ext(list_wnf); - u32 sup_loc = term_val(list_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Copy A = term_clone(lab, acc); - Term app0 = term_new_app(A.k0, x); - Term app1 = term_new_app(A.k1, y); - Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); - Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); - return term_new_sup(lab, t0, t1); - } - case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { - // %read_file_go_path(acc, #Nil) - // ---------------------------- read-file-go-path-nil - // %read_file_go_io(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); - Term path = term_new_app(acc, nil); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); - } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { - // %read_file_go_path(acc, #Con{h,t}) - // --------------------------------- read-file-go-path-con - // %read_file_go_chr(acc, h, t) - u32 con_loc = term_val(list_wnf); - Term head = heap_read(con_loc + 0); - Term tail = heap_read(con_loc + 1); - Term args0[3] = {acc, head, tail}; - Term t = term_new_pri(table_find("read_file_go_chr", 16), 3, args0); - return wnf(t); - } - // %read_file_go_path(acc, x) - // ------------------------- read-file-go-path-fallback - // %read_file_go_io(acc(x)) - Term path = term_new_app(acc, list_wnf); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); - } - default: { - // %read_file_go_path(acc, x) - // ------------------------- read-file-go-path-default - // %read_file_go_io(acc(x)) - Term path = term_new_app(acc, list_wnf); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); - } - } -} - -// %read_file_go_chr(acc, head, tail) -// --------------------------------- -// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. -fn Term read_file_go_chr(Term *args) { - Term acc = args[0]; - Term head_wnf = wnf(args[1]); - Term tail = args[2]; - - switch (term_tag(head_wnf)) { - case ERA: { - // %read_file_go_chr(acc, &{}, t) - // ----------------------------- read-file-go-chr-era - // &{} - return term_new_era(); - } - case INC: { - // %read_file_go_chr(acc, ↑x, t) - // ------------------------------ read-file-go-chr-inc - // ↑(%read_file(acc(#Con{x, t}))) - u32 inc_loc = term_val(head_wnf); - Term inner = heap_read(inc_loc); - Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term app = term_new_app(acc, con); - Term next = term_new_pri(table_find("read_file", 9), 1, &app); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %read_file_go_chr(acc, &L{x,y}, t) - // --------------------------------- read-file-go-chr-sup - // &L{%read_file(acc0(#Con{x, t0})), %read_file(acc1(#Con{y, t1}))} - u32 lab = term_ext(head_wnf); - u32 sup_loc = term_val(head_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Copy A = term_clone(lab, acc); - Copy T = term_clone(lab, tail); - Term con0_args[2] = {x, T.k0}; - Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); - Term app0 = term_new_app(A.k0, con0); - Term app1 = term_new_app(A.k1, con1); - Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); - Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); - return term_new_sup(lab, t0, t1); - } - case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { - // %read_file_go_chr(acc, #Chr{c}, t) - // ---------------------------------- read-file-go-chr-chr - // %read_file_go_num(acc, c, t) - u32 chr_loc = term_val(head_wnf); - Term code = heap_read(chr_loc + 0); - Term args0[3] = {acc, code, tail}; - Term t = term_new_pri(table_find("read_file_go_num", 16), 3, args0); - return wnf(t); - } - // %read_file_go_chr(acc, h, t) - // ---------------------------- read-file-go-chr-fallback - // %read_file_go_io(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); - } - default: { - // %read_file_go_chr(acc, h, t) - // ---------------------------- read-file-go-chr-default - // %read_file_go_io(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); - } - } -} - -// %read_file_go_num(acc, code, tail) -// --------------------------------- -// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. -fn Term read_file_go_num(Term *args) { - Term acc = args[0]; - Term code_wnf = wnf(args[1]); - Term tail = args[2]; - - switch (term_tag(code_wnf)) { - case ERA: { - // %read_file_go_num(acc, &{}, t) - // ----------------------------- read-file-go-num-era - // &{} - return term_new_era(); - } - case INC: { - // %read_file_go_num(acc, ↑x, t) - // ------------------------------ read-file-go-num-inc - // ↑(%read_file(acc(#Con{#Chr{x}, t}))) - u32 inc_loc = term_val(code_wnf); - Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); - Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term app = term_new_app(acc, con); - Term next = term_new_pri(table_find("read_file", 9), 1, &app); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %read_file_go_num(acc, &L{x,y}, t) - // --------------------------------- read-file-go-num-sup - // &L{%read_file(acc0(#Con{#Chr{x}, t0})), %read_file(acc1(#Con{#Chr{y}, t1}))} - u32 lab = term_ext(code_wnf); - u32 sup_loc = term_val(code_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Copy A = term_clone(lab, acc); - Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); - Term con0_args[2] = {chr0, T.k0}; - Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); - Term app0 = term_new_app(A.k0, con0); - Term app1 = term_new_app(A.k1, con1); - Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); - Term t1 = term_new_pri(table_find("read_file", 9), 1, &app1); - return term_new_sup(lab, t0, t1); - } - case NUM: { - // %read_file_go_num(acc, n, t) - // ----------------------------- read-file-go-num-num - // %read_file_go_path(λx.acc(#Con{#Chr{n}, x}), t) - u64 loc = heap_alloc(1); - Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); - Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term bod = term_new_app(acc, con); - Term acc_next = term_new_lam_at(loc, bod); - Term args0[2] = {acc_next, tail}; - Term t = term_new_pri(table_find("read_file_go_path", 17), 2, args0); - return wnf(t); - } - default: { - // %read_file_go_num(acc, c, t) - // ---------------------------- read-file-go-num-default - // %read_file_go_io(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); - Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); - } - } -} - -fn void prim_read_file_init(void) { - prim_register("read_file_go_io", 15, 1, prim_fn_read_file_go_io); - prim_register("read_file", 9, 1, prim_fn_read_file); - prim_register("read_file_go_path", 17, 2, read_file_go_path); - prim_register("read_file_go_chr", 16, 3, read_file_go_chr); - prim_register("read_file_go_num", 16, 3, read_file_go_num); -} From 8b38fb516b77966298004e94e36a0540cbee046b Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 20:10:42 +0400 Subject: [PATCH 07/35] read/write_file/byte all dealing with INC/SUP/ERA --- clang/prim/fn/read_bytes.c | 288 ++++++++++++++++++++++++++++++++-- clang/prim/fn/write_bytes.c | 305 ++++++++++++++++++++++++++++++++++-- clang/prim/fn/write_file.c | 301 +++++++++++++++++++++++++++++++++-- 3 files changed, 847 insertions(+), 47 deletions(-) diff --git a/clang/prim/fn/read_bytes.c b/clang/prim/fn/read_bytes.c index 0e772197..9d740537 100644 --- a/clang/prim/fn/read_bytes.c +++ b/clang/prim/fn/read_bytes.c @@ -1,20 +1,273 @@ -#include -#include -#include -#include -fn void print_term(Term term); -fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); -fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); -fn Term term_string_printf(const char *fmt, ...); +fn Term read_bytes_go_path(Term *args); +fn Term read_bytes_go_chr(Term *args); +fn Term read_bytes_go_num(Term *args); // %read_bytes(path) -// ---------------- -// #OK{List<#BYT{NUM}>} | #ERR{String} +// ----------------- +// %read_bytes_go_path(λx.x, path) fn Term prim_fn_read_bytes(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("read_bytes_go_path", 18), 2, args0); + return wnf(t); +} + +// %read_bytes_go_path(acc, list) +// ------------------------------ +// Walk list shape with lifting over ERA/INC/SUP. +fn Term read_bytes_go_path(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %read_bytes_go_path(acc, &{}) + // ----------------------------- read-bytes-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %read_bytes_go_path(acc, ↑x) + // ---------------------------- read-bytes-go-path-inc + // ↑(%read_bytes(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("read_bytes", 10), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_bytes_go_path(acc, &L{x,y}) + // --------------------------------- read-bytes-go-path-sup + // &L{%read_bytes(acc0(x)), %read_bytes(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("read_bytes", 10), 1, &app0); + Term t1 = term_new_pri(table_find("read_bytes", 10), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %read_bytes_go_path(acc, #Nil) + // ------------------------------ read-bytes-go-path-nil + // %read_bytes_go_io(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term path = term_new_app(acc, nil); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %read_bytes_go_path(acc, #Con{h,t}) + // ----------------------------------- read-bytes-go-path-con + // %read_bytes_go_chr(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("read_bytes_go_chr", 17), 3, args0); + return wnf(t); + } + // %read_bytes_go_path(acc, x) + // ---------------------------- read-bytes-go-path-fallback + // %read_bytes_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); + return wnf(io); + } + default: { + // %read_bytes_go_path(acc, x) + // ---------------------------- read-bytes-go-path-default + // %read_bytes_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); + return wnf(io); + } + } +} + +// %read_bytes_go_chr(acc, head, tail) +// ------------------------------------ +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term read_bytes_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %read_bytes_go_chr(acc, &{}, t) + // ------------------------------- read-bytes-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %read_bytes_go_chr(acc, ↑x, t) + // ------------------------------- read-bytes-go-chr-inc + // ↑(%read_bytes(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("read_bytes", 10), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_bytes_go_chr(acc, &L{x,y}, t) + // ------------------------------------ read-bytes-go-chr-sup + // &L{%read_bytes(acc0(#Con{x, t0})), %read_bytes(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("read_bytes", 10), 1, &app0); + Term t1 = term_new_pri(table_find("read_bytes", 10), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %read_bytes_go_chr(acc, #Chr{c}, t) + // ------------------------------------ read-bytes-go-chr-chr + // %read_bytes_go_num(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("read_bytes_go_num", 17), 3, args0); + return wnf(t); + } + // %read_bytes_go_chr(acc, h, t) + // ------------------------------ read-bytes-go-chr-fallback + // %read_bytes_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); + return wnf(io); + } + default: { + // %read_bytes_go_chr(acc, h, t) + // ------------------------------ read-bytes-go-chr-default + // %read_bytes_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); + return wnf(io); + } + } +} + +// %read_bytes_go_num(acc, code, tail) +// ------------------------------------ +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term read_bytes_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %read_bytes_go_num(acc, &{}, t) + // ------------------------------- read-bytes-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %read_bytes_go_num(acc, ↑x, t) + // ------------------------------- read-bytes-go-num-inc + // ↑(%read_bytes(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("read_bytes", 10), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %read_bytes_go_num(acc, &L{x,y}, t) + // ------------------------------------ read-bytes-go-num-sup + // &L{%read_bytes(acc0(#Con{#Chr{x}, t0})), %read_bytes(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("read_bytes", 10), 1, &app0); + Term t1 = term_new_pri(table_find("read_bytes", 10), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %read_bytes_go_num(acc, n, t) + // ------------------------------ read-bytes-go-num-num + // %read_bytes_go_path(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("read_bytes_go_path", 18), 2, args0); + return wnf(t); + } + default: { + // %read_bytes_go_num(acc, c, t) + // ------------------------------ read-bytes-go-num-default + // %read_bytes_go_io(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); + return wnf(io); + } + } +} + +// %read_bytes_go_io(path) +// ----------------------- +// #OK{List<#BYT{NUM}>} | #ERR{String} +fn Term prim_fn_read_bytes_go_io(Term *args) { int MAX_PATH = 1024; char path[MAX_PATH]; // UTF-8 bytes const char *OPEN_PATH_ERR_FMT = "ERROR(read_bytes): failed to open path '%s': %s (errno=%d)"; - const char *READ_IO_ERR_FMT = "ERROR(read_bytes): I/O error while reading '%s': %s (errno=%d)"; + const char *READ_IO_ERR_FMT = "ERROR(read_bytes): I/O error while reading '%s': %s (errno=%d)"; // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. HStrErr path_err; @@ -22,7 +275,6 @@ fn Term prim_fn_read_bytes(Term *args) { return term_string_from_hstrerr("read_bytes", "path", MAX_PATH, path_err); } - // Open file and build an HVM list of #BYT{NUM}. FILE *file = fopen(path, "rb"); if (!file) { int err = errno; @@ -33,7 +285,7 @@ fn Term prim_fn_read_bytes(Term *args) { Term Nil = term_new_ctr(NAM_NIL, 0, 0); unsigned char c; // First read distinguishes empty file (EOF) from read error. - if (fread(&c, 1,1, file) != 1) { + if (fread(&c, 1, 1, file) != 1) { if (ferror(file)) { // Capture errno before fclose because fclose may overwrite it. int err = errno; @@ -44,13 +296,14 @@ fn Term prim_fn_read_bytes(Term *args) { fclose(file); return term_new_ctr(NAM_OK, 1, &Nil); } + Term byt[1] = {term_new_num(c)}; Term h_t[2] = {term_new_ctr(NAM_BYT, 1, byt), Nil}; - Term result = term_new_ctr(NAM_CON, 2, h_t); // at each step, the list ends in #NIL + Term result = term_new_ctr(NAM_CON, 2, h_t); // `curr` is the last #CON in the output List<#BYT{NUM}>. Term curr = result; - while (fread(&c, 1,1, file) == 1) { + while (fread(&c, 1, 1, file) == 1) { byt[0] = term_new_num(c); h_t[0] = term_new_ctr(NAM_BYT, 1, byt); // Append #CON{#BYT{NUM}, #NIL} at curr tail. @@ -64,10 +317,15 @@ fn Term prim_fn_read_bytes(Term *args) { fclose(file); return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); } + fclose(file); return term_new_ctr(NAM_OK, 1, &result); } fn void prim_read_bytes_init(void) { prim_register("read_bytes", 10, 1, prim_fn_read_bytes); + prim_register("read_bytes_go_path", 18, 2, read_bytes_go_path); + prim_register("read_bytes_go_chr", 17, 3, read_bytes_go_chr); + prim_register("read_bytes_go_num", 17, 3, read_bytes_go_num); + prim_register("read_bytes_go_io", 16, 1, prim_fn_read_bytes_go_io); } diff --git a/clang/prim/fn/write_bytes.c b/clang/prim/fn/write_bytes.c index da5f4b89..3ab541d8 100644 --- a/clang/prim/fn/write_bytes.c +++ b/clang/prim/fn/write_bytes.c @@ -1,25 +1,294 @@ -#include -#include -#include -#include -fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); -fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); -fn Term term_string_printf(const char *fmt, ...); +fn Term write_bytes_go_path(Term *args); +fn Term write_bytes_go_chr(Term *args); +fn Term write_bytes_go_num(Term *args); // %write_bytes(path, data) // ------------------------ -// #OK{#NIL} | #ERR{String} +// %write_bytes_go_path(λx.x, path, data) fn Term prim_fn_write_bytes(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[3] = {acc, args[0], args[1]}; + Term t = term_new_pri(table_find("write_bytes_go_path", 19), 3, args0); + return wnf(t); +} + +// %write_bytes_go_path(acc, list, data) +// -------------------------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term write_bytes_go_path(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + Term data = args[2]; + + switch (term_tag(list_wnf)) { + case ERA: { + // %write_bytes_go_path(acc, &{}, data) + // ------------------------------------- write-bytes-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %write_bytes_go_path(acc, ↑x, data) + // ------------------------------------ write-bytes-go-path-inc + // ↑(%write_bytes(acc(x), data)) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next_args[2] = {app, data}; + Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_bytes_go_path(acc, &L{x,y}, data) + // ----------------------------------------- write-bytes-go-path-sup + // &L{%write_bytes(acc0(x), data0), %write_bytes(acc1(y), data1)} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy D = term_clone(lab, data); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term args0[2] = {app0, D.k0}; + Term args1[2] = {app1, D.k1}; + Term t0 = term_new_pri(table_find("write_bytes", 11), 2, args0); + Term t1 = term_new_pri(table_find("write_bytes", 11), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %write_bytes_go_path(acc, #Nil, data) + // -------------------------------------- write-bytes-go-path-nil + // %write_bytes_go_io(acc(#Nil), data) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term path = term_new_app(acc, nil); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %write_bytes_go_path(acc, #Con{h,t}, data) + // ------------------------------------------- write-bytes-go-path-con + // %write_bytes_go_chr(acc, h, t, data) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[4] = {acc, head, tail, data}; + Term t = term_new_pri(table_find("write_bytes_go_chr", 18), 4, args0); + return wnf(t); + } + // %write_bytes_go_path(acc, x, data) + // ----------------------------------- write-bytes-go-path-fallback + // %write_bytes_go_io(acc(x), data) + Term path = term_new_app(acc, list_wnf); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + default: { + // %write_bytes_go_path(acc, x, data) + // ----------------------------------- write-bytes-go-path-default + // %write_bytes_go_io(acc(x), data) + Term path = term_new_app(acc, list_wnf); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + } +} + +// %write_bytes_go_chr(acc, head, tail, data) +// ------------------------------------------- +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term write_bytes_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + Term data = args[3]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %write_bytes_go_chr(acc, &{}, t, data) + // --------------------------------------- write-bytes-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %write_bytes_go_chr(acc, ↑x, t, data) + // -------------------------------------- write-bytes-go-chr-inc + // ↑(%write_bytes(acc(#Con{x, t}), data)) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next_args[2] = {app, data}; + Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_bytes_go_chr(acc, &L{x,y}, t, data) + // ------------------------------------------- write-bytes-go-chr-sup + // &L{%write_bytes(acc0(#Con{x, t0}), data0), %write_bytes(acc1(#Con{y, t1}), data1)} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Copy D = term_clone(lab, data); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term args0[2] = {app0, D.k0}; + Term args1[2] = {app1, D.k1}; + Term t0 = term_new_pri(table_find("write_bytes", 11), 2, args0); + Term t1 = term_new_pri(table_find("write_bytes", 11), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %write_bytes_go_chr(acc, #Chr{c}, t, data) + // ------------------------------------------- write-bytes-go-chr-chr + // %write_bytes_go_num(acc, c, t, data) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[4] = {acc, code, tail, data}; + Term t = term_new_pri(table_find("write_bytes_go_num", 18), 4, args0); + return wnf(t); + } + // %write_bytes_go_chr(acc, h, t, data) + // ------------------------------------- write-bytes-go-chr-fallback + // %write_bytes_go_io(acc(#Con{h, t}), data) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + default: { + // %write_bytes_go_chr(acc, h, t, data) + // ------------------------------------- write-bytes-go-chr-default + // %write_bytes_go_io(acc(#Con{h, t}), data) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + } +} + +// %write_bytes_go_num(acc, code, tail, data) +// ------------------------------------------- +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term write_bytes_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + Term data = args[3]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %write_bytes_go_num(acc, &{}, t, data) + // --------------------------------------- write-bytes-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %write_bytes_go_num(acc, ↑x, t, data) + // -------------------------------------- write-bytes-go-num-inc + // ↑(%write_bytes(acc(#Con{#Chr{x}, t}), data)) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next_args[2] = {app, data}; + Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_bytes_go_num(acc, &L{x,y}, t, data) + // ------------------------------------------- write-bytes-go-num-sup + // &L{%write_bytes(acc0(#Con{#Chr{x}, t0}), data0), %write_bytes(acc1(#Con{#Chr{y}, t1}), data1)} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Copy D = term_clone(lab, data); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term args0[2] = {app0, D.k0}; + Term args1[2] = {app1, D.k1}; + Term t0 = term_new_pri(table_find("write_bytes", 11), 2, args0); + Term t1 = term_new_pri(table_find("write_bytes", 11), 2, args1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %write_bytes_go_num(acc, n, t, data) + // ------------------------------------- write-bytes-go-num-num + // %write_bytes_go_path(λx.acc(#Con{#Chr{n}, x}), t, data) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[3] = {acc_next, tail, data}; + Term t = term_new_pri(table_find("write_bytes_go_path", 19), 3, args0); + return wnf(t); + } + default: { + // %write_bytes_go_num(acc, c, t, data) + // ------------------------------------- write-bytes-go-num-default + // %write_bytes_go_io(acc(#Con{#Chr{c}, t}), data) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + } +} + +// %write_bytes_go_io(path, data) +// ------------------------------ +// #OK{#NIL} | #ERR{String} +fn Term prim_fn_write_bytes_go_io(Term *args) { int MAX_PATH = 1024; char path[MAX_PATH]; // UTF-8 bytes int data_i = 0; Term data_item = args[1]; - const char *DATA_EXPECTED = "ERROR(write_bytes): invalid `data`; expected #NIL or #CON(#BYT{NUM}, tail)"; - const char *OPEN_PATH_ERR_FMT = "ERROR(write_bytes): failed to open path '%s': %s (errno=%d)"; + const char *DATA_EXPECTED = "ERROR(write_bytes): invalid `data`; expected #NIL or #CON(#BYT{NUM}, tail)"; + const char *OPEN_PATH_ERR_FMT = "ERROR(write_bytes): failed to open path '%s': %s (errno=%d)"; const char *DATA_INVALID_BYTE_FMT = "ERROR(write_bytes): invalid byte %llu at `data` index %i; expected 0..255"; - const char *WRITE_IO_ERR_FMT = "ERROR(write_bytes): I/O error while writing '%s': %s (errno=%d)"; - const char *FLUSH_ERR_FMT = "ERROR(write_bytes): failed to flush '%s': %s (errno=%d)"; - const char *CLOSE_ERR_FMT = "ERROR(write_bytes): failed to close '%s': %s (errno=%d)"; + const char *WRITE_IO_ERR_FMT = "ERROR(write_bytes): I/O error while writing '%s': %s (errno=%d)"; + const char *FLUSH_ERR_FMT = "ERROR(write_bytes): failed to flush '%s': %s (errno=%d)"; + const char *CLOSE_ERR_FMT = "ERROR(write_bytes): failed to close '%s': %s (errno=%d)"; // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. HStrErr path_err; @@ -33,7 +302,7 @@ fn Term prim_fn_write_bytes(Term *args) { return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); } - // Write hvm4 bytes list (#BYT[]) into `file`. + // Write hvm4 bytes list List<#BYT{NUM}> into file. data_item = wnf(data_item); while (term_tag(data_item) == C02) { // wnf(data_item) must be List<#BYT{b}> @@ -54,8 +323,7 @@ fn Term prim_fn_write_bytes(Term *args) { } Term b_loc = term_val(head); - Term b_trm = heap_read(b_loc); - b_trm = wnf(b_trm); + Term b_trm = wnf(heap_read(b_loc)); // b in #BYT{b} must be NUM if (term_tag(b_trm) != NUM) { @@ -79,7 +347,6 @@ fn Term prim_fn_write_bytes(Term *args) { } data_i += 1; - // Recurse data_item = wnf(tail); } @@ -106,4 +373,8 @@ fn Term prim_fn_write_bytes(Term *args) { fn void prim_write_bytes_init(void) { prim_register("write_bytes", 11, 2, prim_fn_write_bytes); + prim_register("write_bytes_go_path", 19, 3, write_bytes_go_path); + prim_register("write_bytes_go_chr", 18, 4, write_bytes_go_chr); + prim_register("write_bytes_go_num", 18, 4, write_bytes_go_num); + prim_register("write_bytes_go_io", 17, 2, prim_fn_write_bytes_go_io); } diff --git a/clang/prim/fn/write_file.c b/clang/prim/fn/write_file.c index dd3e6c8a..dadcdbc3 100644 --- a/clang/prim/fn/write_file.c +++ b/clang/prim/fn/write_file.c @@ -1,26 +1,294 @@ -#include -#include -#include -#include -fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStrErr *err); -fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HStrErr err); -fn int utf8_encode_scalar(u32 cp, char out[4]); -fn Term term_string_printf(const char *fmt, ...); +fn Term write_file_go_path(Term *args); +fn Term write_file_go_chr(Term *args); +fn Term write_file_go_num(Term *args); // %write_file(path, data) // ----------------------- -// #OK{#NIL} | #ERR{String} +// %write_file_go_path(λx.x, path, data) fn Term prim_fn_write_file(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[3] = {acc, args[0], args[1]}; + Term t = term_new_pri(table_find("write_file_go_path", 18), 3, args0); + return wnf(t); +} + +// %write_file_go_path(acc, list, data) +// ------------------------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term write_file_go_path(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + Term data = args[2]; + + switch (term_tag(list_wnf)) { + case ERA: { + // %write_file_go_path(acc, &{}, data) + // ------------------------------------ write-file-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %write_file_go_path(acc, ↑x, data) + // ----------------------------------- write-file-go-path-inc + // ↑(%write_file(acc(x), data)) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next_args[2] = {app, data}; + Term next = term_new_pri(table_find("write_file", 10), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_file_go_path(acc, &L{x,y}, data) + // ---------------------------------------- write-file-go-path-sup + // &L{%write_file(acc0(x), data0), %write_file(acc1(y), data1)} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy D = term_clone(lab, data); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term args0[2] = {app0, D.k0}; + Term args1[2] = {app1, D.k1}; + Term t0 = term_new_pri(table_find("write_file", 10), 2, args0); + Term t1 = term_new_pri(table_find("write_file", 10), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %write_file_go_path(acc, #Nil, data) + // ------------------------------------- write-file-go-path-nil + // %write_file_go_io(acc(#Nil), data) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term path = term_new_app(acc, nil); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %write_file_go_path(acc, #Con{h,t}, data) + // ------------------------------------------ write-file-go-path-con + // %write_file_go_chr(acc, h, t, data) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[4] = {acc, head, tail, data}; + Term t = term_new_pri(table_find("write_file_go_chr", 17), 4, args0); + return wnf(t); + } + // %write_file_go_path(acc, x, data) + // ---------------------------------- write-file-go-path-fallback + // %write_file_go_io(acc(x), data) + Term path = term_new_app(acc, list_wnf); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + default: { + // %write_file_go_path(acc, x, data) + // ---------------------------------- write-file-go-path-default + // %write_file_go_io(acc(x), data) + Term path = term_new_app(acc, list_wnf); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + } +} + +// %write_file_go_chr(acc, head, tail, data) +// ------------------------------------------ +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term write_file_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + Term data = args[3]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %write_file_go_chr(acc, &{}, t, data) + // -------------------------------------- write-file-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %write_file_go_chr(acc, ↑x, t, data) + // ------------------------------------- write-file-go-chr-inc + // ↑(%write_file(acc(#Con{x, t}), data)) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next_args[2] = {app, data}; + Term next = term_new_pri(table_find("write_file", 10), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_file_go_chr(acc, &L{x,y}, t, data) + // ------------------------------------------ write-file-go-chr-sup + // &L{%write_file(acc0(#Con{x, t0}), data0), %write_file(acc1(#Con{y, t1}), data1)} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Copy D = term_clone(lab, data); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term args0[2] = {app0, D.k0}; + Term args1[2] = {app1, D.k1}; + Term t0 = term_new_pri(table_find("write_file", 10), 2, args0); + Term t1 = term_new_pri(table_find("write_file", 10), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %write_file_go_chr(acc, #Chr{c}, t, data) + // ------------------------------------------ write-file-go-chr-chr + // %write_file_go_num(acc, c, t, data) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[4] = {acc, code, tail, data}; + Term t = term_new_pri(table_find("write_file_go_num", 17), 4, args0); + return wnf(t); + } + // %write_file_go_chr(acc, h, t, data) + // ------------------------------------ write-file-go-chr-fallback + // %write_file_go_io(acc(#Con{h, t}), data) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + default: { + // %write_file_go_chr(acc, h, t, data) + // ------------------------------------ write-file-go-chr-default + // %write_file_go_io(acc(#Con{h, t}), data) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + } +} + +// %write_file_go_num(acc, code, tail, data) +// ------------------------------------------ +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term write_file_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + Term data = args[3]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %write_file_go_num(acc, &{}, t, data) + // -------------------------------------- write-file-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %write_file_go_num(acc, ↑x, t, data) + // ------------------------------------- write-file-go-num-inc + // ↑(%write_file(acc(#Con{#Chr{x}, t}), data)) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next_args[2] = {app, data}; + Term next = term_new_pri(table_find("write_file", 10), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_file_go_num(acc, &L{x,y}, t, data) + // ------------------------------------------ write-file-go-num-sup + // &L{%write_file(acc0(#Con{#Chr{x}, t0}), data0), %write_file(acc1(#Con{#Chr{y}, t1}), data1)} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Copy D = term_clone(lab, data); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term args0[2] = {app0, D.k0}; + Term args1[2] = {app1, D.k1}; + Term t0 = term_new_pri(table_find("write_file", 10), 2, args0); + Term t1 = term_new_pri(table_find("write_file", 10), 2, args1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %write_file_go_num(acc, n, t, data) + // ------------------------------------ write-file-go-num-num + // %write_file_go_path(λx.acc(#Con{#Chr{n}, x}), t, data) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[3] = {acc_next, tail, data}; + Term t = term_new_pri(table_find("write_file_go_path", 18), 3, args0); + return wnf(t); + } + default: { + // %write_file_go_num(acc, c, t, data) + // ------------------------------------ write-file-go-num-default + // %write_file_go_io(acc(#Con{#Chr{c}, t}), data) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + } +} + +// %write_file_go_io(path, data) +// ----------------------------- +// #OK{#NIL} | #ERR{String} +fn Term prim_fn_write_file_go_io(Term *args) { int MAX_PATH = 1024; char path[MAX_PATH]; // UTF-8 bytes int data_i = 0; Term data_item = args[1]; - const char *DATA_EXPECTED = "ERROR(write_file): invalid `data`; expected #NIL or #CON(#CHR{NUM}, tail)"; - const char *OPEN_PATH_ERR_FMT = "ERROR(write_file): failed to open path '%s': %s (errno=%d)"; + const char *DATA_EXPECTED = "ERROR(write_file): invalid `data`; expected #NIL or #CON(#CHR{NUM}, tail)"; + const char *OPEN_PATH_ERR_FMT = "ERROR(write_file): failed to open path '%s': %s (errno=%d)"; const char *DATA_INVALID_CP_FMT = "ERROR(write_file): invalid UTF-32 codepoint U+%08llX at `data` index %i"; - const char *WRITE_IO_ERR_FMT = "ERROR(write_file): I/O error while writing '%s': %s (errno=%d)"; - const char *FLUSH_ERR_FMT = "ERROR(write_file): failed to flush '%s': %s (errno=%d)"; - const char *CLOSE_ERR_FMT = "ERROR(write_file): failed to close '%s': %s (errno=%d)"; + const char *WRITE_IO_ERR_FMT = "ERROR(write_file): I/O error while writing '%s': %s (errno=%d)"; + const char *FLUSH_ERR_FMT = "ERROR(write_file): failed to flush '%s': %s (errno=%d)"; + const char *CLOSE_ERR_FMT = "ERROR(write_file): failed to close '%s': %s (errno=%d)"; // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. HStrErr path_err; @@ -80,7 +348,6 @@ fn Term prim_fn_write_file(Term *args) { } data_i += 1; - // Recurse data_item = wnf(tail); } @@ -107,4 +374,8 @@ fn Term prim_fn_write_file(Term *args) { fn void prim_write_file_init(void) { prim_register("write_file", 10, 2, prim_fn_write_file); + prim_register("write_file_go_path", 18, 3, write_file_go_path); + prim_register("write_file_go_chr", 17, 4, write_file_go_chr); + prim_register("write_file_go_num", 17, 4, write_file_go_num); + prim_register("write_file_go_io", 16, 2, prim_fn_write_file_go_io); } From eec7d786856c5be695dfc47113a04b8f7baba3fd Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Mon, 9 Feb 2026 20:25:39 +0400 Subject: [PATCH 08/35] WIP: panic and rand dealing with INC/ERA/SUP --- clang/prim/fn/panic.c | 271 +++++++++++++++++++++++++++++++++++++++++- clang/prim/fn/rand.c | 57 ++++++++- 2 files changed, 320 insertions(+), 8 deletions(-) diff --git a/clang/prim/fn/panic.c b/clang/prim/fn/panic.c index ebe16587..9e0edb53 100644 --- a/clang/prim/fn/panic.c +++ b/clang/prim/fn/panic.c @@ -1,14 +1,279 @@ fn Term prim_fn_log(Term *args); +fn Term panic_go_msg(Term *args); +fn Term panic_go_chr(Term *args); +fn Term panic_go_num(Term *args); -// %panic(s) -// ---------------- panic +// %panic_go_abort(s) +// ------------------ // !t = %log(s); abort -fn Term prim_fn_panic(Term *args) { +fn Term prim_fn_panic_go_abort(Term *args) { (void)prim_fn_log(args); exit(1); return term_new_era(); } +// %panic(s) +// --------- +// %panic_go_msg(λx.x, s) +fn Term prim_fn_panic(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("panic_go_msg", 12), 2, args0); + return wnf(t); +} + +// %panic_go_msg(acc, list) +// ------------------------ +// Walk list shape with lifting over ERA/INC/SUP. +fn Term panic_go_msg(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %panic_go_msg(acc, &{}) + // ----------------------- panic-go-msg-era + // &{} + return term_new_era(); + } + case INC: { + // %panic_go_msg(acc, ↑x) + // ---------------------- panic-go-msg-inc + // ↑(%panic(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("panic", 5), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %panic_go_msg(acc, &L{x,y}) + // --------------------------- panic-go-msg-sup + // &L{%panic(acc0(x)), %panic(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("panic", 5), 1, &app0); + Term t1 = term_new_pri(table_find("panic", 5), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %panic_go_msg(acc, #Nil) + // ------------------------ panic-go-msg-nil + // %panic_go_abort(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term str = term_new_app(acc, nil); + Term args0[1] = {str}; + Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); + return wnf(t); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %panic_go_msg(acc, #Con{h,t}) + // ----------------------------- panic-go-msg-con + // %panic_go_chr(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("panic_go_chr", 12), 3, args0); + return wnf(t); + } + // %panic_go_msg(acc, x) + // ---------------------- panic-go-msg-fallback + // %panic_go_abort(acc(x)) + Term str = term_new_app(acc, list_wnf); + Term args0[1] = {str}; + Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); + return wnf(t); + } + default: { + // %panic_go_msg(acc, x) + // ---------------------- panic-go-msg-default + // %panic_go_abort(acc(x)) + Term str = term_new_app(acc, list_wnf); + Term args0[1] = {str}; + Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); + return wnf(t); + } + } +} + +// %panic_go_chr(acc, head, tail) +// ------------------------------ +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term panic_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %panic_go_chr(acc, &{}, t) + // -------------------------- panic-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %panic_go_chr(acc, ↑x, t) + // ------------------------- panic-go-chr-inc + // ↑(%panic(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("panic", 5), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %panic_go_chr(acc, &L{x,y}, t) + // ------------------------------ panic-go-chr-sup + // &L{%panic(acc0(#Con{x, t0})), %panic(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("panic", 5), 1, &app0); + Term t1 = term_new_pri(table_find("panic", 5), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %panic_go_chr(acc, #Chr{c}, t) + // ------------------------------ panic-go-chr-chr + // %panic_go_num(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("panic_go_num", 12), 3, args0); + return wnf(t); + } + // %panic_go_chr(acc, h, t) + // ------------------------- panic-go-chr-fallback + // %panic_go_abort(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term str = term_new_app(acc, con); + Term args0[1] = {str}; + Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); + return wnf(t); + } + default: { + // %panic_go_chr(acc, h, t) + // ------------------------- panic-go-chr-default + // %panic_go_abort(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term str = term_new_app(acc, con); + Term args0[1] = {str}; + Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); + return wnf(t); + } + } +} + +// %panic_go_num(acc, code, tail) +// ------------------------------ +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term panic_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %panic_go_num(acc, &{}, t) + // -------------------------- panic-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %panic_go_num(acc, ↑x, t) + // ------------------------- panic-go-num-inc + // ↑(%panic(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("panic", 5), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %panic_go_num(acc, &L{x,y}, t) + // ------------------------------ panic-go-num-sup + // &L{%panic(acc0(#Con{#Chr{x}, t0})), %panic(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("panic", 5), 1, &app0); + Term t1 = term_new_pri(table_find("panic", 5), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %panic_go_num(acc, n, t) + // ------------------------- panic-go-num-num + // %panic_go_msg(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("panic_go_msg", 12), 2, args0); + return wnf(t); + } + default: { + // %panic_go_num(acc, c, t) + // ------------------------- panic-go-num-default + // %panic_go_abort(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term str = term_new_app(acc, con); + Term args0[1] = {str}; + Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); + return wnf(t); + } + } +} + fn void prim_panic_init(void) { prim_register("panic", 5, 1, prim_fn_panic); + prim_register("panic_go_msg", 12, 2, panic_go_msg); + prim_register("panic_go_chr", 12, 3, panic_go_chr); + prim_register("panic_go_num", 12, 3, panic_go_num); + prim_register("panic_go_abort", 14, 1, prim_fn_panic_go_abort); } diff --git a/clang/prim/fn/rand.c b/clang/prim/fn/rand.c index 39ed8284..85762fb0 100644 --- a/clang/prim/fn/rand.c +++ b/clang/prim/fn/rand.c @@ -1,13 +1,60 @@ -#include +fn Term rand_go_dummy(Term *args); // %rand(dummy) -// ------------ rand -// NUM +// ------------ +// %rand_go_dummy(dummy) fn Term prim_fn_rand(Term *args) { - (void)args[0]; // dummy arg; arity 1 for now - return term_new_num((u32)rand()); + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("rand_go_dummy", 13), 1, args0); + return wnf(t); +} + +// %rand_go_dummy(dummy) +// --------------------- +// Lift dummy over ERA/INC/SUP; default ignores dummy and returns fresh NUM. +fn Term rand_go_dummy(Term *args) { + Term dummy_wnf = wnf(args[0]); + + switch (term_tag(dummy_wnf)) { + case ERA: { + // %rand_go_dummy(&{}) + // ------------------- rand-go-dummy-era + // &{} + return term_new_era(); + } + case INC: { + // %rand_go_dummy(↑x) + // ------------------ rand-go-dummy-inc + // ↑(%rand(x)) + u32 inc_loc = term_val(dummy_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("rand", 4), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %rand_go_dummy(&L{x,y}) + // ----------------------- rand-go-dummy-sup + // &L{%rand(x), %rand(y)} + u32 lab = term_ext(dummy_wnf); + u32 sup_loc = term_val(dummy_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("rand", 4), 1, &x); + Term t1 = term_new_pri(table_find("rand", 4), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %rand_go_dummy(x) + // ----------------- rand-go-dummy-default + // NUM + (void)dummy_wnf; + return term_new_num((u32)rand()); + } + } } fn void prim_rand_init(void) { prim_register("rand", 4, 1, prim_fn_rand); + prim_register("rand_go_dummy", 13, 1, rand_go_dummy); } From 8bf01bf7211701654a5c4812db08bc19544cd455 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 08:11:00 -0300 Subject: [PATCH 09/35] timer primitive --- clang/hvm.c | 9 +++ clang/prim/fn/timer/_.c | 147 ++++++++++++++++++++++++++++++++++++ clang/prim/fn/timer/poll.c | 86 +++++++++++++++++++++ clang/prim/fn/timer/start.c | 91 ++++++++++++++++++++++ clang/prim/fn/timer/wait.c | 87 +++++++++++++++++++++ clang/prim/init.c | 1 + clang/prim/string.c | 2 + 7 files changed, 423 insertions(+) create mode 100644 clang/prim/fn/timer/_.c create mode 100644 clang/prim/fn/timer/poll.c create mode 100644 clang/prim/fn/timer/start.c create mode 100644 clang/prim/fn/timer/wait.c diff --git a/clang/hvm.c b/clang/hvm.c index ebf54fe1..b6b6098e 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -4,6 +4,7 @@ #include #include #include +#include #include #include #include @@ -358,10 +359,18 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "print/name.c" #include "print/utf8.c" #include "prim/register.c" +#include "prim/string.c" #include "prim/fn/log.c" #include "prim/fn/log_go_0.c" #include "prim/fn/log_go_1.c" #include "prim/fn/log_go_2.c" +#include "prim/fn/panic.c" +#include "prim/fn/rand.c" +#include "prim/fn/read_bytes.c" +#include "prim/fn/write_bytes.c" +#include "prim/fn/read_file.c" +#include "prim/fn/write_file.c" +#include "prim/fn/timer/_.c" #include "prim/init.c" #include "print/term.c" diff --git a/clang/prim/fn/timer/_.c b/clang/prim/fn/timer/_.c new file mode 100644 index 00000000..675d6e8f --- /dev/null +++ b/clang/prim/fn/timer/_.c @@ -0,0 +1,147 @@ +#define TIMER_CAP (1u << 20) + +#define TIMER_ERR_BAD_ARG 1 +#define TIMER_ERR_BAD_HANDLE 2 +#define TIMER_ERR_STALE 3 +#define TIMER_ERR_FULL 4 + +typedef struct { + u32 expected_seq; + u64 due_ns; +} TimerSlot; + +static TimerSlot TIMER_SLOTS[TIMER_CAP]; +static u32 TIMER_NEXT_ID = 1; +static pthread_mutex_t TIMER_LOCK = PTHREAD_MUTEX_INITIALIZER; + +static u32 TIMER_NAM_TIME = 0; +static u32 TIMER_NAM_PEND = 0; +static u32 TIMER_NAM_RDY = 0; + +fn Term wnf(Term term); + +fn u64 timer_now_ns(void) { + struct timespec ts; + clock_gettime(CLOCK_MONOTONIC, &ts); + return (u64)ts.tv_sec * 1000000000ull + (u64)ts.tv_nsec; +} + +fn void timer_sleep_ns(u64 ns) { + struct timespec req = { + .tv_sec = (time_t)(ns / 1000000000ull), + .tv_nsec = (long)(ns % 1000000000ull), + }; + + while (req.tv_sec != 0 || req.tv_nsec != 0) { + if (nanosleep(&req, &req) == 0) { + return; + } + } +} + +fn Term timer_new_err(const char *prim, u32 code, const char *msg) { + Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); + return term_new_ctr(NAM_ERR, 1, &txt); +} + +fn Term timer_new_time(u32 id, u32 seq) { + Term args[2] = {term_new_num(id), term_new_num(seq)}; + return term_new_ctr(TIMER_NAM_TIME, 2, args); +} + +fn Term timer_new_pend(u32 id, u32 seq) { + Term time = timer_new_time(id, seq); + return term_new_ctr(TIMER_NAM_PEND, 1, &time); +} + +fn Term timer_new_rdy(u32 id, u32 seq) { + Term time = timer_new_time(id, seq); + return term_new_ctr(TIMER_NAM_RDY, 1, &time); +} + +fn u8 timer_parse_num(Term term, u32 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case NUM: { + *out = term_val(val); + return 1; + } + default: { + return 0; + } + } +} + +fn u8 timer_parse_handle(Term term, u32 *id, u32 *seq) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C02: { + if (term_ext(val) != TIMER_NAM_TIME) { + return 0; + } + + u32 loc = term_val(val); + Term id_tm = heap_read(loc + 0); + Term seq_tm = heap_read(loc + 1); + + if (!timer_parse_num(id_tm, id)) { + return 0; + } + if (!timer_parse_num(seq_tm, seq)) { + return 0; + } + return 1; + } + default: { + return 0; + } + } +} + +fn u8 timer_is_valid_id(u32 id) { + pthread_mutex_lock(&TIMER_LOCK); + + if (id == 0 || id >= TIMER_NEXT_ID || id >= TIMER_CAP) { + pthread_mutex_unlock(&TIMER_LOCK); + return 0; + } + + pthread_mutex_unlock(&TIMER_LOCK); + return 1; +} + +fn u8 timer_claim(u32 id, u32 seq, u64 *due_ns) { + pthread_mutex_lock(&TIMER_LOCK); + + if (id == 0 || id >= TIMER_NEXT_ID || id >= TIMER_CAP) { + pthread_mutex_unlock(&TIMER_LOCK); + return 0; + } + + TimerSlot *slot = &TIMER_SLOTS[id]; + if (slot->expected_seq != seq) { + pthread_mutex_unlock(&TIMER_LOCK); + return 0; + } + + slot->expected_seq = seq + 1; + *due_ns = slot->due_ns; + pthread_mutex_unlock(&TIMER_LOCK); + return 1; +} + +#include "start.c" +#include "poll.c" +#include "wait.c" + +fn void prim_timer_init(void) { + TIMER_NAM_TIME = nick_from_str("Time", 4); + TIMER_NAM_PEND = nick_from_str("Pend", 4); + TIMER_NAM_RDY = nick_from_str("Rdy", 3); + + prim_timer_start_init(); + prim_timer_poll_init(); + prim_timer_wait_init(); +} diff --git a/clang/prim/fn/timer/poll.c b/clang/prim/fn/timer/poll.c new file mode 100644 index 00000000..1ba6dd30 --- /dev/null +++ b/clang/prim/fn/timer/poll.c @@ -0,0 +1,86 @@ +// %timer_poll(time) +// ----------------- +// %timer_poll_go_time(time) +fn Term prim_fn_timer_poll(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("timer_poll_go_time", 18), 1, args0); + return wnf(t); +} + +// %timer_poll_go_time(time) +// ------------------------- +// Lift `time` over ERA/INC/SUP; default forwards to io stage. +fn Term timer_poll_go_time(Term *args) { + Term time_wnf = wnf(args[0]); + + switch (term_tag(time_wnf)) { + case ERA: { + // %timer_poll_go_time(&{}) + // ------------------------ timer-poll-go-time-era + // &{} + return term_new_era(); + } + case INC: { + // %timer_poll_go_time(↑x) + // ----------------------- timer-poll-go-time-inc + // ↑(%timer_poll(x)) + u32 inc_loc = term_val(time_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("timer_poll", 10), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %timer_poll_go_time(&L{x,y}) + // ---------------------------- timer-poll-go-time-sup + // &L{%timer_poll(x), %timer_poll(y)} + u32 lab = term_ext(time_wnf); + u32 sup_loc = term_val(time_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("timer_poll", 10), 1, &x); + Term t1 = term_new_pri(table_find("timer_poll", 10), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %timer_poll_go_time(time) + // ------------------------- timer-poll-go-time-default + // %timer_poll_go_io(time) + Term args0[1] = {time_wnf}; + Term t = term_new_pri(table_find("timer_poll_go_io", 16), 1, args0); + return wnf(t); + } + } +} + +// %timer_poll_go_io(time) +// ----------------------- +// #Pend{#Time{id,seq+1}} | #Rdy{#Time{id,seq+1}} | #ERR{String} +fn Term prim_fn_timer_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!timer_parse_handle(args[0], &id, &seq)) { + return timer_new_err("timer_poll", TIMER_ERR_BAD_HANDLE, "invalid `time`; expected #Time{id,seq}"); + } + + if (!timer_is_valid_id(id)) { + return timer_new_err("timer_poll", TIMER_ERR_BAD_HANDLE, "unknown timer id"); + } + + u64 due_ns = 0; + if (!timer_claim(id, seq, &due_ns)) { + return timer_new_err("timer_poll", TIMER_ERR_STALE, "stale timer handle"); + } + + u64 now = timer_now_ns(); + if (now >= due_ns) { + return timer_new_rdy(id, seq + 1); + } + return timer_new_pend(id, seq + 1); +} + +fn void prim_timer_poll_init(void) { + prim_register("timer_poll", 10, 1, prim_fn_timer_poll); + prim_register("timer_poll_go_time", 18, 1, timer_poll_go_time); + prim_register("timer_poll_go_io", 16, 1, prim_fn_timer_poll_go_io); +} diff --git a/clang/prim/fn/timer/start.c b/clang/prim/fn/timer/start.c new file mode 100644 index 00000000..d9166e91 --- /dev/null +++ b/clang/prim/fn/timer/start.c @@ -0,0 +1,91 @@ +// %timer_start(ms) +// ---------------- +// %timer_start_go_ms(ms) +fn Term prim_fn_timer_start(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("timer_start_go_ms", 17), 1, args0); + return wnf(t); +} + +// %timer_start_go_ms(ms) +// ---------------------- +// Lift `ms` over ERA/INC/SUP; default forwards to io stage. +fn Term timer_start_go_ms(Term *args) { + Term ms_wnf = wnf(args[0]); + + switch (term_tag(ms_wnf)) { + case ERA: { + // %timer_start_go_ms(&{}) + // ----------------------- timer-start-go-ms-era + // &{} + return term_new_era(); + } + case INC: { + // %timer_start_go_ms(↑x) + // ---------------------- timer-start-go-ms-inc + // ↑(%timer_start(x)) + u32 inc_loc = term_val(ms_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("timer_start", 11), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %timer_start_go_ms(&L{x,y}) + // --------------------------- timer-start-go-ms-sup + // &L{%timer_start(x), %timer_start(y)} + u32 lab = term_ext(ms_wnf); + u32 sup_loc = term_val(ms_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("timer_start", 11), 1, &x); + Term t1 = term_new_pri(table_find("timer_start", 11), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %timer_start_go_ms(ms) + // ---------------------- timer-start-go-ms-default + // %timer_start_go_io(ms) + Term args0[1] = {ms_wnf}; + Term t = term_new_pri(table_find("timer_start_go_io", 17), 1, args0); + return wnf(t); + } + } +} + +// %timer_start_go_io(ms) +// ---------------------- +// #Time{id,0} | #ERR{String} +fn Term prim_fn_timer_start_go_io(Term *args) { + u32 ms = 0; + if (!timer_parse_num(args[0], &ms)) { + return timer_new_err("timer_start", TIMER_ERR_BAD_ARG, "invalid `ms`; expected NUM"); + } + + u64 now = timer_now_ns(); + u64 due = now + (u64)ms * 1000000ull; + if (due < now) { + due = UINT64_MAX; + } + + pthread_mutex_lock(&TIMER_LOCK); + + u32 id = TIMER_NEXT_ID; + if (id >= TIMER_CAP) { + pthread_mutex_unlock(&TIMER_LOCK); + return timer_new_err("timer_start", TIMER_ERR_FULL, "timer table is full"); + } + + TIMER_NEXT_ID = id + 1; + TIMER_SLOTS[id].expected_seq = 0; + TIMER_SLOTS[id].due_ns = due; + + pthread_mutex_unlock(&TIMER_LOCK); + return timer_new_time(id, 0); +} + +fn void prim_timer_start_init(void) { + prim_register("timer_start", 11, 1, prim_fn_timer_start); + prim_register("timer_start_go_ms", 17, 1, timer_start_go_ms); + prim_register("timer_start_go_io", 17, 1, prim_fn_timer_start_go_io); +} diff --git a/clang/prim/fn/timer/wait.c b/clang/prim/fn/timer/wait.c new file mode 100644 index 00000000..60fb796a --- /dev/null +++ b/clang/prim/fn/timer/wait.c @@ -0,0 +1,87 @@ +// %timer_wait(time) +// ----------------- +// %timer_wait_go_time(time) +fn Term prim_fn_timer_wait(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("timer_wait_go_time", 18), 1, args0); + return wnf(t); +} + +// %timer_wait_go_time(time) +// ------------------------- +// Lift `time` over ERA/INC/SUP; default forwards to io stage. +fn Term timer_wait_go_time(Term *args) { + Term time_wnf = wnf(args[0]); + + switch (term_tag(time_wnf)) { + case ERA: { + // %timer_wait_go_time(&{}) + // ------------------------ timer-wait-go-time-era + // &{} + return term_new_era(); + } + case INC: { + // %timer_wait_go_time(↑x) + // ----------------------- timer-wait-go-time-inc + // ↑(%timer_wait(x)) + u32 inc_loc = term_val(time_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("timer_wait", 10), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %timer_wait_go_time(&L{x,y}) + // ---------------------------- timer-wait-go-time-sup + // &L{%timer_wait(x), %timer_wait(y)} + u32 lab = term_ext(time_wnf); + u32 sup_loc = term_val(time_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("timer_wait", 10), 1, &x); + Term t1 = term_new_pri(table_find("timer_wait", 10), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %timer_wait_go_time(time) + // ------------------------- timer-wait-go-time-default + // %timer_wait_go_io(time) + Term args0[1] = {time_wnf}; + Term t = term_new_pri(table_find("timer_wait_go_io", 16), 1, args0); + return wnf(t); + } + } +} + +// %timer_wait_go_io(time) +// ----------------------- +// #Rdy{#Time{id,seq+1}} | #ERR{String} +fn Term prim_fn_timer_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!timer_parse_handle(args[0], &id, &seq)) { + return timer_new_err("timer_wait", TIMER_ERR_BAD_HANDLE, "invalid `time`; expected #Time{id,seq}"); + } + + if (!timer_is_valid_id(id)) { + return timer_new_err("timer_wait", TIMER_ERR_BAD_HANDLE, "unknown timer id"); + } + + u64 due_ns = 0; + if (!timer_claim(id, seq, &due_ns)) { + return timer_new_err("timer_wait", TIMER_ERR_STALE, "stale timer handle"); + } + + u64 now = timer_now_ns(); + if (now < due_ns) { + timer_sleep_ns(due_ns - now); + } + + return timer_new_rdy(id, seq + 1); +} + +fn void prim_timer_wait_init(void) { + prim_register("timer_wait", 10, 1, prim_fn_timer_wait); + prim_register("timer_wait_go_time", 18, 1, timer_wait_go_time); + prim_register("timer_wait_go_io", 16, 1, prim_fn_timer_wait_go_io); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 22315b4e..9d7c1005 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -2,6 +2,7 @@ fn void prim_init(void) { prim_log_init(); prim_panic_init(); prim_rand_init(); + prim_timer_init(); prim_read_bytes_init(); prim_write_bytes_init(); prim_read_file_init(); diff --git a/clang/prim/string.c b/clang/prim/string.c index b7e3debc..2786237d 100644 --- a/clang/prim/string.c +++ b/clang/prim/string.c @@ -2,6 +2,8 @@ #include #include +fn Term wnf(Term term); + // Type helpers typedef enum HStrErrKind HStrErrKind; typedef struct HStrErr HStrErr; From 0861ab805568bce0df920fd76a41900f2bfcd32d Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 08:11:12 -0300 Subject: [PATCH 10/35] timer prim tests --- test/prim_timer_bad_handle.hvm4 | 2 ++ test/prim_timer_inc.hvm4 | 2 ++ test/prim_timer_poll_pending.hvm4 | 2 ++ test/prim_timer_stale.hvm4 | 5 +++++ test/prim_timer_start.hvm4 | 2 ++ test/prim_timer_sup.hvm4 | 2 ++ test/prim_timer_wait_era.hvm4 | 2 ++ test/prim_timer_wait_zero.hvm4 | 2 ++ 8 files changed, 19 insertions(+) create mode 100644 test/prim_timer_bad_handle.hvm4 create mode 100644 test/prim_timer_inc.hvm4 create mode 100644 test/prim_timer_poll_pending.hvm4 create mode 100644 test/prim_timer_stale.hvm4 create mode 100644 test/prim_timer_start.hvm4 create mode 100644 test/prim_timer_sup.hvm4 create mode 100644 test/prim_timer_wait_era.hvm4 create mode 100644 test/prim_timer_wait_zero.hvm4 diff --git a/test/prim_timer_bad_handle.hvm4 b/test/prim_timer_bad_handle.hvm4 new file mode 100644 index 00000000..8cb6d636 --- /dev/null +++ b/test/prim_timer_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_poll(#Time{1,0}) +//EXPECT_CONTAINS:E2 unknown timer id diff --git a/test/prim_timer_inc.hvm4 b/test/prim_timer_inc.hvm4 new file mode 100644 index 00000000..d6567ae8 --- /dev/null +++ b/test/prim_timer_inc.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_wait(↑%timer_start(0)) +//!↑#Rdy{#Time{1,1}} diff --git a/test/prim_timer_poll_pending.hvm4 b/test/prim_timer_poll_pending.hvm4 new file mode 100644 index 00000000..e08ca62c --- /dev/null +++ b/test/prim_timer_poll_pending.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_poll(%timer_start(1000)) +//!#Pend{#Time{1,1}} diff --git a/test/prim_timer_stale.hvm4 b/test/prim_timer_stale.hvm4 new file mode 100644 index 00000000..b8ba06b8 --- /dev/null +++ b/test/prim_timer_stale.hvm4 @@ -0,0 +1,5 @@ +@main = + !!&h = %timer_start(0); + !!x = %timer_poll(h); + %timer_poll(h) +//EXPECT_CONTAINS:E3 stale timer handle diff --git a/test/prim_timer_start.hvm4 b/test/prim_timer_start.hvm4 new file mode 100644 index 00000000..74d98a38 --- /dev/null +++ b/test/prim_timer_start.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_start(0) +//!#Time{1,0} diff --git a/test/prim_timer_sup.hvm4 b/test/prim_timer_sup.hvm4 new file mode 100644 index 00000000..23557e12 --- /dev/null +++ b/test/prim_timer_sup.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_wait(&L{%timer_start(0), %timer_start(0)}) +//!&L{#Rdy{#Time{1,1}},#Rdy{#Time{2,1}}} diff --git a/test/prim_timer_wait_era.hvm4 b/test/prim_timer_wait_era.hvm4 new file mode 100644 index 00000000..c7b1c53a --- /dev/null +++ b/test/prim_timer_wait_era.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_wait(&{}) +//!&{} diff --git a/test/prim_timer_wait_zero.hvm4 b/test/prim_timer_wait_zero.hvm4 new file mode 100644 index 00000000..7cda3872 --- /dev/null +++ b/test/prim_timer_wait_zero.hvm4 @@ -0,0 +1,2 @@ +@main = %timer_wait(%timer_start(0)) +//!#Rdy{#Time{1,1}} From 338bc1f42eaadabf8db061ddbc172efdfdca1ee4 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 09:26:28 -0300 Subject: [PATCH 11/35] process primitives and tests --- clang/hvm.c | 1 + clang/prim/fn/process/_.c | 195 ++++++++++++++++++++++++++++ clang/prim/fn/process/kill.c | 112 ++++++++++++++++ clang/prim/fn/process/poll.c | 108 +++++++++++++++ clang/prim/fn/process/spawn.c | 103 +++++++++++++++ clang/prim/fn/process/wait.c | 104 +++++++++++++++ clang/prim/init.c | 1 + test/prim_process_bad_handle.hvm4 | 2 + test/prim_process_kill_done.hvm4 | 11 ++ test/prim_process_poll_inc.hvm4 | 2 + test/prim_process_poll_pending.hvm4 | 2 + test/prim_process_spawn.hvm4 | 2 + test/prim_process_stale.hvm4 | 5 + test/prim_process_sup.hvm4 | 2 + test/prim_process_wait_era.hvm4 | 2 + test/prim_process_wait_exit.hvm4 | 2 + 16 files changed, 654 insertions(+) create mode 100644 clang/prim/fn/process/_.c create mode 100644 clang/prim/fn/process/kill.c create mode 100644 clang/prim/fn/process/poll.c create mode 100644 clang/prim/fn/process/spawn.c create mode 100644 clang/prim/fn/process/wait.c create mode 100644 test/prim_process_bad_handle.hvm4 create mode 100644 test/prim_process_kill_done.hvm4 create mode 100644 test/prim_process_poll_inc.hvm4 create mode 100644 test/prim_process_poll_pending.hvm4 create mode 100644 test/prim_process_spawn.hvm4 create mode 100644 test/prim_process_stale.hvm4 create mode 100644 test/prim_process_sup.hvm4 create mode 100644 test/prim_process_wait_era.hvm4 create mode 100644 test/prim_process_wait_exit.hvm4 diff --git a/clang/hvm.c b/clang/hvm.c index b6b6098e..891f1642 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -366,6 +366,7 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/log_go_2.c" #include "prim/fn/panic.c" #include "prim/fn/rand.c" +#include "prim/fn/process/_.c" #include "prim/fn/read_bytes.c" #include "prim/fn/write_bytes.c" #include "prim/fn/read_file.c" diff --git a/clang/prim/fn/process/_.c b/clang/prim/fn/process/_.c new file mode 100644 index 00000000..58e5aa37 --- /dev/null +++ b/clang/prim/fn/process/_.c @@ -0,0 +1,195 @@ +#include +#include +#include + +#define PROCESS_CAP (1u << 20) + +#define PROCESS_ERR_BAD_ARG 1 +#define PROCESS_ERR_BAD_HANDLE 2 +#define PROCESS_ERR_STALE 3 +#define PROCESS_ERR_FULL 4 +#define PROCESS_ERR_IO 5 + +typedef struct { + u32 expected_seq; + pid_t pid; + u8 finished; + u8 signaled; + u32 code; +} ProcessSlot; + +static ProcessSlot PROCESS_SLOTS[PROCESS_CAP]; +static u32 PROCESS_NEXT_ID = 1; +static pthread_mutex_t PROCESS_LOCK = PTHREAD_MUTEX_INITIALIZER; + +static u32 PROCESS_NAM_PROC = 0; +static u32 PROCESS_NAM_PEND = 0; +static u32 PROCESS_NAM_RDY = 0; +static u32 PROCESS_NAM_EXIT = 0; +static u32 PROCESS_NAM_SIG = 0; + +fn Term wnf(Term term); + +fn Term process_new_err(const char *prim, u32 code, const char *msg) { + Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); + return term_new_ctr(NAM_ERR, 1, &txt); +} + +fn Term process_new_proc(u32 id, u32 seq) { + Term args[2] = {term_new_num(id), term_new_num(seq)}; + return term_new_ctr(PROCESS_NAM_PROC, 2, args); +} + +fn Term process_new_pend(u32 id, u32 seq) { + Term proc = process_new_proc(id, seq); + return term_new_ctr(PROCESS_NAM_PEND, 1, &proc); +} + +fn Term process_new_exit(u32 code) { + Term arg = term_new_num(code); + return term_new_ctr(PROCESS_NAM_EXIT, 1, &arg); +} + +fn Term process_new_sig(u32 sig) { + Term arg = term_new_num(sig); + return term_new_ctr(PROCESS_NAM_SIG, 1, &arg); +} + +fn Term process_new_rdy(u32 id, u32 seq, u8 signaled, u32 code) { + Term proc = process_new_proc(id, seq); + Term st = signaled ? process_new_sig(code) : process_new_exit(code); + Term args[2] = {proc, st}; + return term_new_ctr(PROCESS_NAM_RDY, 2, args); +} + +fn u8 process_parse_num(Term term, u32 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case NUM: { + *out = term_val(val); + return 1; + } + default: { + return 0; + } + } +} + +fn u8 process_parse_handle(Term term, u32 *id, u32 *seq) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C02: { + if (term_ext(val) != PROCESS_NAM_PROC) { + return 0; + } + + u32 loc = term_val(val); + Term id_tm = heap_read(loc + 0); + Term seq_tm = heap_read(loc + 1); + + if (!process_parse_num(id_tm, id)) { + return 0; + } + if (!process_parse_num(seq_tm, seq)) { + return 0; + } + return 1; + } + default: { + return 0; + } + } +} + +fn u8 process_is_valid_id(u32 id) { + pthread_mutex_lock(&PROCESS_LOCK); + + if (id == 0 || id >= PROCESS_NEXT_ID || id >= PROCESS_CAP) { + pthread_mutex_unlock(&PROCESS_LOCK); + return 0; + } + + pthread_mutex_unlock(&PROCESS_LOCK); + return 1; +} + +fn void process_set_finished(u32 id, u8 signaled, u32 code) { + pthread_mutex_lock(&PROCESS_LOCK); + + if (id != 0 && id < PROCESS_NEXT_ID && id < PROCESS_CAP) { + ProcessSlot *slot = &PROCESS_SLOTS[id]; + slot->finished = 1; + slot->signaled = signaled; + slot->code = code; + } + + pthread_mutex_unlock(&PROCESS_LOCK); +} + +fn u8 process_claim( + u32 id, + u32 seq, + pid_t *pid, + u8 *finished, + u8 *signaled, + u32 *code +) { + pthread_mutex_lock(&PROCESS_LOCK); + + if (id == 0 || id >= PROCESS_NEXT_ID || id >= PROCESS_CAP) { + pthread_mutex_unlock(&PROCESS_LOCK); + return 0; + } + + ProcessSlot *slot = &PROCESS_SLOTS[id]; + if (slot->expected_seq != seq) { + pthread_mutex_unlock(&PROCESS_LOCK); + return 0; + } + + slot->expected_seq = seq + 1; + *pid = slot->pid; + *finished = slot->finished; + *signaled = slot->signaled; + *code = slot->code; + + pthread_mutex_unlock(&PROCESS_LOCK); + return 1; +} + +fn void process_status_from_wait(int status, u8 *signaled, u32 *code) { + if (WIFEXITED(status)) { + *signaled = 0; + *code = (u32)WEXITSTATUS(status); + return; + } + + if (WIFSIGNALED(status)) { + *signaled = 1; + *code = (u32)WTERMSIG(status); + return; + } + + *signaled = 0; + *code = 255; +} + +#include "spawn.c" +#include "poll.c" +#include "wait.c" +#include "kill.c" + +fn void prim_process_init(void) { + PROCESS_NAM_PROC = nick_from_str("Proc", 4); + PROCESS_NAM_PEND = nick_from_str("Pend", 4); + PROCESS_NAM_RDY = nick_from_str("Rdy", 3); + PROCESS_NAM_EXIT = nick_from_str("Exit", 4); + PROCESS_NAM_SIG = nick_from_str("Sig", 3); + + prim_process_spawn_init(); + prim_process_poll_init(); + prim_process_wait_init(); + prim_process_kill_init(); +} diff --git a/clang/prim/fn/process/kill.c b/clang/prim/fn/process/kill.c new file mode 100644 index 00000000..50c3f5a6 --- /dev/null +++ b/clang/prim/fn/process/kill.c @@ -0,0 +1,112 @@ +// %process_kill(proc) +// ------------------- +// %process_kill_go_proc(proc) +fn Term prim_fn_process_kill(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("process_kill_go_proc", 20), 1, args0); + return wnf(t); +} + +// %process_kill_go_proc(proc) +// --------------------------- +// Lift `proc` over ERA/INC/SUP; default forwards to io stage. +fn Term process_kill_go_proc(Term *args) { + Term proc_wnf = wnf(args[0]); + + switch (term_tag(proc_wnf)) { + case ERA: { + // %process_kill_go_proc(&{}) + // --------------------------- process-kill-go-proc-era + // &{} + return term_new_era(); + } + case INC: { + // %process_kill_go_proc(↑x) + // -------------------------- process-kill-go-proc-inc + // ↑(%process_kill(x)) + u32 inc_loc = term_val(proc_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("process_kill", 12), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %process_kill_go_proc(&L{x,y}) + // ------------------------------- process-kill-go-proc-sup + // &L{%process_kill(x), %process_kill(y)} + u32 lab = term_ext(proc_wnf); + u32 sup_loc = term_val(proc_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("process_kill", 12), 1, &x); + Term t1 = term_new_pri(table_find("process_kill", 12), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %process_kill_go_proc(proc) + // --------------------------- process-kill-go-proc-default + // %process_kill_go_io(proc) + Term args0[1] = {proc_wnf}; + Term t = term_new_pri(table_find("process_kill_go_io", 18), 1, args0); + return wnf(t); + } + } +} + +// %process_kill_go_io(proc) +// ------------------------- +// #Pend{#Proc{id,seq+1}} | #Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}} | #ERR{String} +fn Term prim_fn_process_kill_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!process_parse_handle(args[0], &id, &seq)) { + return process_new_err("process_kill", PROCESS_ERR_BAD_HANDLE, "invalid `proc`; expected #Proc{id,seq}"); + } + + if (!process_is_valid_id(id)) { + return process_new_err("process_kill", PROCESS_ERR_BAD_HANDLE, "unknown process id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 signaled = 0; + u32 code = 0; + if (!process_claim(id, seq, &pid, &finished, &signaled, &code)) { + return process_new_err("process_kill", PROCESS_ERR_STALE, "stale process handle"); + } + + if (finished) { + return process_new_rdy(id, seq + 1, signaled, code); + } + + if (kill(pid, SIGTERM) < 0 && errno != ESRCH) { + return process_new_err("process_kill", PROCESS_ERR_IO, strerror(errno)); + } + + int status = 0; + pid_t got = 0; + while (1) { + got = waitpid(pid, &status, WNOHANG); + if (got >= 0) { + break; + } + if (errno == EINTR) { + continue; + } + return process_new_err("process_kill", PROCESS_ERR_IO, strerror(errno)); + } + + if (got == 0) { + return process_new_pend(id, seq + 1); + } + + process_status_from_wait(status, &signaled, &code); + process_set_finished(id, signaled, code); + return process_new_rdy(id, seq + 1, signaled, code); +} + +fn void prim_process_kill_init(void) { + prim_register("process_kill", 12, 1, prim_fn_process_kill); + prim_register("process_kill_go_proc", 20, 1, process_kill_go_proc); + prim_register("process_kill_go_io", 18, 1, prim_fn_process_kill_go_io); +} diff --git a/clang/prim/fn/process/poll.c b/clang/prim/fn/process/poll.c new file mode 100644 index 00000000..ab6f847b --- /dev/null +++ b/clang/prim/fn/process/poll.c @@ -0,0 +1,108 @@ +// %process_poll(proc) +// ------------------- +// %process_poll_go_proc(proc) +fn Term prim_fn_process_poll(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("process_poll_go_proc", 20), 1, args0); + return wnf(t); +} + +// %process_poll_go_proc(proc) +// --------------------------- +// Lift `proc` over ERA/INC/SUP; default forwards to io stage. +fn Term process_poll_go_proc(Term *args) { + Term proc_wnf = wnf(args[0]); + + switch (term_tag(proc_wnf)) { + case ERA: { + // %process_poll_go_proc(&{}) + // --------------------------- process-poll-go-proc-era + // &{} + return term_new_era(); + } + case INC: { + // %process_poll_go_proc(↑x) + // -------------------------- process-poll-go-proc-inc + // ↑(%process_poll(x)) + u32 inc_loc = term_val(proc_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("process_poll", 12), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %process_poll_go_proc(&L{x,y}) + // ------------------------------- process-poll-go-proc-sup + // &L{%process_poll(x), %process_poll(y)} + u32 lab = term_ext(proc_wnf); + u32 sup_loc = term_val(proc_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("process_poll", 12), 1, &x); + Term t1 = term_new_pri(table_find("process_poll", 12), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %process_poll_go_proc(proc) + // --------------------------- process-poll-go-proc-default + // %process_poll_go_io(proc) + Term args0[1] = {proc_wnf}; + Term t = term_new_pri(table_find("process_poll_go_io", 18), 1, args0); + return wnf(t); + } + } +} + +// %process_poll_go_io(proc) +// ------------------------- +// #Pend{#Proc{id,seq+1}} | #Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}} | #ERR{String} +fn Term prim_fn_process_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!process_parse_handle(args[0], &id, &seq)) { + return process_new_err("process_poll", PROCESS_ERR_BAD_HANDLE, "invalid `proc`; expected #Proc{id,seq}"); + } + + if (!process_is_valid_id(id)) { + return process_new_err("process_poll", PROCESS_ERR_BAD_HANDLE, "unknown process id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 signaled = 0; + u32 code = 0; + if (!process_claim(id, seq, &pid, &finished, &signaled, &code)) { + return process_new_err("process_poll", PROCESS_ERR_STALE, "stale process handle"); + } + + if (finished) { + return process_new_rdy(id, seq + 1, signaled, code); + } + + int status = 0; + pid_t got = 0; + while (1) { + got = waitpid(pid, &status, WNOHANG); + if (got >= 0) { + break; + } + if (errno == EINTR) { + continue; + } + return process_new_err("process_poll", PROCESS_ERR_IO, strerror(errno)); + } + + if (got == 0) { + return process_new_pend(id, seq + 1); + } + + process_status_from_wait(status, &signaled, &code); + process_set_finished(id, signaled, code); + return process_new_rdy(id, seq + 1, signaled, code); +} + +fn void prim_process_poll_init(void) { + prim_register("process_poll", 12, 1, prim_fn_process_poll); + prim_register("process_poll_go_proc", 20, 1, process_poll_go_proc); + prim_register("process_poll_go_io", 18, 1, prim_fn_process_poll_go_io); +} diff --git a/clang/prim/fn/process/spawn.c b/clang/prim/fn/process/spawn.c new file mode 100644 index 00000000..6f5bdea6 --- /dev/null +++ b/clang/prim/fn/process/spawn.c @@ -0,0 +1,103 @@ +// %process_spawn(cmd) +// ------------------- +// %process_spawn_go_cmd(cmd) +fn Term prim_fn_process_spawn(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("process_spawn_go_cmd", 20), 1, args0); + return wnf(t); +} + +// %process_spawn_go_cmd(cmd) +// -------------------------- +// Lift `cmd` over ERA/INC/SUP; default forwards to io stage. +fn Term process_spawn_go_cmd(Term *args) { + Term cmd_wnf = wnf(args[0]); + + switch (term_tag(cmd_wnf)) { + case ERA: { + // %process_spawn_go_cmd(&{}) + // -------------------------- process-spawn-go-cmd-era + // &{} + return term_new_era(); + } + case INC: { + // %process_spawn_go_cmd(↑x) + // ------------------------- process-spawn-go-cmd-inc + // ↑(%process_spawn(x)) + u32 inc_loc = term_val(cmd_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("process_spawn", 13), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %process_spawn_go_cmd(&L{x,y}) + // ------------------------------ process-spawn-go-cmd-sup + // &L{%process_spawn(x), %process_spawn(y)} + u32 lab = term_ext(cmd_wnf); + u32 sup_loc = term_val(cmd_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("process_spawn", 13), 1, &x); + Term t1 = term_new_pri(table_find("process_spawn", 13), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %process_spawn_go_cmd(cmd) + // -------------------------- process-spawn-go-cmd-default + // %process_spawn_go_io(cmd) + Term args0[1] = {cmd_wnf}; + Term t = term_new_pri(table_find("process_spawn_go_io", 19), 1, args0); + return wnf(t); + } + } +} + +// %process_spawn_go_io(cmd) +// ------------------------- +// #Proc{id,0} | #ERR{String} +fn Term prim_fn_process_spawn_go_io(Term *args) { + int MAX_CMD = 4096; + char cmd[MAX_CMD]; + + HStrErr cmd_err; + if (!term_string_to_utf8_cstr(args[0], cmd, MAX_CMD, NULL, &cmd_err)) { + return term_string_from_hstrerr("process_spawn", "cmd", MAX_CMD, cmd_err); + } + + pid_t pid = fork(); + if (pid < 0) { + int err = errno; + return process_new_err("process_spawn", PROCESS_ERR_IO, strerror(err)); + } + + if (pid == 0) { + execl("/bin/sh", "sh", "-c", cmd, (char *)NULL); + _exit(127); + } + + pthread_mutex_lock(&PROCESS_LOCK); + + u32 id = PROCESS_NEXT_ID; + if (id >= PROCESS_CAP) { + pthread_mutex_unlock(&PROCESS_LOCK); + kill(pid, SIGKILL); + return process_new_err("process_spawn", PROCESS_ERR_FULL, "process table is full"); + } + + PROCESS_NEXT_ID = id + 1; + PROCESS_SLOTS[id].expected_seq = 0; + PROCESS_SLOTS[id].pid = pid; + PROCESS_SLOTS[id].finished = 0; + PROCESS_SLOTS[id].signaled = 0; + PROCESS_SLOTS[id].code = 0; + + pthread_mutex_unlock(&PROCESS_LOCK); + return process_new_proc(id, 0); +} + +fn void prim_process_spawn_init(void) { + prim_register("process_spawn", 13, 1, prim_fn_process_spawn); + prim_register("process_spawn_go_cmd", 20, 1, process_spawn_go_cmd); + prim_register("process_spawn_go_io", 19, 1, prim_fn_process_spawn_go_io); +} diff --git a/clang/prim/fn/process/wait.c b/clang/prim/fn/process/wait.c new file mode 100644 index 00000000..fe3ba43b --- /dev/null +++ b/clang/prim/fn/process/wait.c @@ -0,0 +1,104 @@ +// %process_wait(proc) +// ------------------- +// %process_wait_go_proc(proc) +fn Term prim_fn_process_wait(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("process_wait_go_proc", 20), 1, args0); + return wnf(t); +} + +// %process_wait_go_proc(proc) +// --------------------------- +// Lift `proc` over ERA/INC/SUP; default forwards to io stage. +fn Term process_wait_go_proc(Term *args) { + Term proc_wnf = wnf(args[0]); + + switch (term_tag(proc_wnf)) { + case ERA: { + // %process_wait_go_proc(&{}) + // --------------------------- process-wait-go-proc-era + // &{} + return term_new_era(); + } + case INC: { + // %process_wait_go_proc(↑x) + // -------------------------- process-wait-go-proc-inc + // ↑(%process_wait(x)) + u32 inc_loc = term_val(proc_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("process_wait", 12), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %process_wait_go_proc(&L{x,y}) + // ------------------------------- process-wait-go-proc-sup + // &L{%process_wait(x), %process_wait(y)} + u32 lab = term_ext(proc_wnf); + u32 sup_loc = term_val(proc_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("process_wait", 12), 1, &x); + Term t1 = term_new_pri(table_find("process_wait", 12), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %process_wait_go_proc(proc) + // --------------------------- process-wait-go-proc-default + // %process_wait_go_io(proc) + Term args0[1] = {proc_wnf}; + Term t = term_new_pri(table_find("process_wait_go_io", 18), 1, args0); + return wnf(t); + } + } +} + +// %process_wait_go_io(proc) +// ------------------------- +// #Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}} | #ERR{String} +fn Term prim_fn_process_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!process_parse_handle(args[0], &id, &seq)) { + return process_new_err("process_wait", PROCESS_ERR_BAD_HANDLE, "invalid `proc`; expected #Proc{id,seq}"); + } + + if (!process_is_valid_id(id)) { + return process_new_err("process_wait", PROCESS_ERR_BAD_HANDLE, "unknown process id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 signaled = 0; + u32 code = 0; + if (!process_claim(id, seq, &pid, &finished, &signaled, &code)) { + return process_new_err("process_wait", PROCESS_ERR_STALE, "stale process handle"); + } + + if (finished) { + return process_new_rdy(id, seq + 1, signaled, code); + } + + int status = 0; + pid_t got = 0; + while (1) { + got = waitpid(pid, &status, 0); + if (got >= 0) { + break; + } + if (errno == EINTR) { + continue; + } + return process_new_err("process_wait", PROCESS_ERR_IO, strerror(errno)); + } + + process_status_from_wait(status, &signaled, &code); + process_set_finished(id, signaled, code); + return process_new_rdy(id, seq + 1, signaled, code); +} + +fn void prim_process_wait_init(void) { + prim_register("process_wait", 12, 1, prim_fn_process_wait); + prim_register("process_wait_go_proc", 20, 1, process_wait_go_proc); + prim_register("process_wait_go_io", 18, 1, prim_fn_process_wait_go_io); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 9d7c1005..27a99a15 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -2,6 +2,7 @@ fn void prim_init(void) { prim_log_init(); prim_panic_init(); prim_rand_init(); + prim_process_init(); prim_timer_init(); prim_read_bytes_init(); prim_write_bytes_init(); diff --git a/test/prim_process_bad_handle.hvm4 b/test/prim_process_bad_handle.hvm4 new file mode 100644 index 00000000..7fc6964c --- /dev/null +++ b/test/prim_process_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %process_poll(#Proc{1,0}) +//EXPECT_CONTAINS:E2 unknown process id diff --git a/test/prim_process_kill_done.hvm4 b/test/prim_process_kill_done.hvm4 new file mode 100644 index 00000000..22ffd7d1 --- /dev/null +++ b/test/prim_process_kill_done.hvm4 @@ -0,0 +1,11 @@ +@get_proc = λ{ + #Rdy: λp.λs.p + #Pend: λp.p + &{} +} + +@main = + !!r = %process_wait(%process_spawn("exit 0")); + !!p = @get_proc(r); + %process_kill(p) +//!#Rdy{#Proc{1,2},#Exit{0}} diff --git a/test/prim_process_poll_inc.hvm4 b/test/prim_process_poll_inc.hvm4 new file mode 100644 index 00000000..fb164c29 --- /dev/null +++ b/test/prim_process_poll_inc.hvm4 @@ -0,0 +1,2 @@ +@main = %process_poll(↑#Proc{1,0}) +//!↑#ERR{"ERROR(process_poll): E2 unknown process id"} diff --git a/test/prim_process_poll_pending.hvm4 b/test/prim_process_poll_pending.hvm4 new file mode 100644 index 00000000..788476cb --- /dev/null +++ b/test/prim_process_poll_pending.hvm4 @@ -0,0 +1,2 @@ +@main = %process_poll(%process_spawn("sleep 1")) +//!#Pend{#Proc{1,1}} diff --git a/test/prim_process_spawn.hvm4 b/test/prim_process_spawn.hvm4 new file mode 100644 index 00000000..7b4e4cf8 --- /dev/null +++ b/test/prim_process_spawn.hvm4 @@ -0,0 +1,2 @@ +@main = %process_spawn("exit 0") +//!#Proc{1,0} diff --git a/test/prim_process_stale.hvm4 b/test/prim_process_stale.hvm4 new file mode 100644 index 00000000..77762100 --- /dev/null +++ b/test/prim_process_stale.hvm4 @@ -0,0 +1,5 @@ +@main = + !!&p = %process_spawn("exit 0"); + !!x = %process_poll(p); + %process_poll(p) +//EXPECT_CONTAINS:E3 stale process handle diff --git a/test/prim_process_sup.hvm4 b/test/prim_process_sup.hvm4 new file mode 100644 index 00000000..56673552 --- /dev/null +++ b/test/prim_process_sup.hvm4 @@ -0,0 +1,2 @@ +@main = %process_wait(&L{%process_spawn("exit 0"), %process_spawn("exit 0")}) +//!&L{#Rdy{#Proc{1,1},#Exit{0}},#Rdy{#Proc{2,1},#Exit{0}}} diff --git a/test/prim_process_wait_era.hvm4 b/test/prim_process_wait_era.hvm4 new file mode 100644 index 00000000..e7374ff4 --- /dev/null +++ b/test/prim_process_wait_era.hvm4 @@ -0,0 +1,2 @@ +@main = %process_wait(&{}) +//!&{} diff --git a/test/prim_process_wait_exit.hvm4 b/test/prim_process_wait_exit.hvm4 new file mode 100644 index 00000000..f10184b2 --- /dev/null +++ b/test/prim_process_wait_exit.hvm4 @@ -0,0 +1,2 @@ +@main = %process_wait(%process_spawn("exit 7")) +//!#Rdy{#Proc{1,1},#Exit{7}} From 12854b3e54fe2c03f5eac99a2eacbd19108fc314 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Tue, 10 Feb 2026 14:33:01 +0400 Subject: [PATCH 12/35] refactor --- clang/prim/fn/panic.c | 14 ++-------- clang/prim/fn/rand.c | 55 ++----------------------------------- clang/prim/fn/read_bytes.c | 14 ++-------- clang/prim/fn/read_file.c | 14 ++-------- clang/prim/fn/write_bytes.c | 14 ++-------- clang/prim/fn/write_file.c | 14 ++-------- 6 files changed, 13 insertions(+), 112 deletions(-) diff --git a/clang/prim/fn/panic.c b/clang/prim/fn/panic.c index 9e0edb53..61918215 100644 --- a/clang/prim/fn/panic.c +++ b/clang/prim/fn/panic.c @@ -88,11 +88,7 @@ fn Term panic_go_msg(Term *args) { } // %panic_go_msg(acc, x) // ---------------------- panic-go-msg-fallback - // %panic_go_abort(acc(x)) - Term str = term_new_app(acc, list_wnf); - Term args0[1] = {str}; - Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); - return wnf(t); + // fallthrough default } default: { // %panic_go_msg(acc, x) @@ -167,13 +163,7 @@ fn Term panic_go_chr(Term *args) { } // %panic_go_chr(acc, h, t) // ------------------------- panic-go-chr-fallback - // %panic_go_abort(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term str = term_new_app(acc, con); - Term args0[1] = {str}; - Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); - return wnf(t); + // fallthrough default } default: { // %panic_go_chr(acc, h, t) diff --git a/clang/prim/fn/rand.c b/clang/prim/fn/rand.c index 85762fb0..35f942d5 100644 --- a/clang/prim/fn/rand.c +++ b/clang/prim/fn/rand.c @@ -1,60 +1,11 @@ -fn Term rand_go_dummy(Term *args); - // %rand(dummy) // ------------ -// %rand_go_dummy(dummy) +// NUM fn Term prim_fn_rand(Term *args) { - Term args0[1] = {args[0]}; - Term t = term_new_pri(table_find("rand_go_dummy", 13), 1, args0); - return wnf(t); -} - -// %rand_go_dummy(dummy) -// --------------------- -// Lift dummy over ERA/INC/SUP; default ignores dummy and returns fresh NUM. -fn Term rand_go_dummy(Term *args) { - Term dummy_wnf = wnf(args[0]); - - switch (term_tag(dummy_wnf)) { - case ERA: { - // %rand_go_dummy(&{}) - // ------------------- rand-go-dummy-era - // &{} - return term_new_era(); - } - case INC: { - // %rand_go_dummy(↑x) - // ------------------ rand-go-dummy-inc - // ↑(%rand(x)) - u32 inc_loc = term_val(dummy_wnf); - Term inner = heap_read(inc_loc); - Term next = term_new_pri(table_find("rand", 4), 1, &inner); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %rand_go_dummy(&L{x,y}) - // ----------------------- rand-go-dummy-sup - // &L{%rand(x), %rand(y)} - u32 lab = term_ext(dummy_wnf); - u32 sup_loc = term_val(dummy_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Term t0 = term_new_pri(table_find("rand", 4), 1, &x); - Term t1 = term_new_pri(table_find("rand", 4), 1, &y); - return term_new_sup(lab, t0, t1); - } - default: { - // %rand_go_dummy(x) - // ----------------- rand-go-dummy-default - // NUM - (void)dummy_wnf; - return term_new_num((u32)rand()); - } - } + (void)args[0]; + return term_new_num((u32)rand()); } fn void prim_rand_init(void) { prim_register("rand", 4, 1, prim_fn_rand); - prim_register("rand_go_dummy", 13, 1, rand_go_dummy); } diff --git a/clang/prim/fn/read_bytes.c b/clang/prim/fn/read_bytes.c index 9d740537..d8c02879 100644 --- a/clang/prim/fn/read_bytes.c +++ b/clang/prim/fn/read_bytes.c @@ -78,11 +78,7 @@ fn Term read_bytes_go_path(Term *args) { } // %read_bytes_go_path(acc, x) // ---------------------------- read-bytes-go-path-fallback - // %read_bytes_go_io(acc(x)) - Term path = term_new_app(acc, list_wnf); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); - return wnf(io); + // fallthrough default } default: { // %read_bytes_go_path(acc, x) @@ -157,13 +153,7 @@ fn Term read_bytes_go_chr(Term *args) { } // %read_bytes_go_chr(acc, h, t) // ------------------------------ read-bytes-go-chr-fallback - // %read_bytes_go_io(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); - return wnf(io); + // fallthrough default } default: { // %read_bytes_go_chr(acc, h, t) diff --git a/clang/prim/fn/read_file.c b/clang/prim/fn/read_file.c index 7a8dce21..1c8f8458 100644 --- a/clang/prim/fn/read_file.c +++ b/clang/prim/fn/read_file.c @@ -78,11 +78,7 @@ fn Term read_file_go_path(Term *args) { } // %read_file_go_path(acc, x) // ------------------------- read-file-go-path-fallback - // %read_file_go_io(acc(x)) - Term path = term_new_app(acc, list_wnf); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); + // fallthrough default } default: { // %read_file_go_path(acc, x) @@ -157,13 +153,7 @@ fn Term read_file_go_chr(Term *args) { } // %read_file_go_chr(acc, h, t) // ---------------------------- read-file-go-chr-fallback - // %read_file_go_io(acc(#Con{h, t})) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[1] = {path}; - Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); - return wnf(io); + // fallthrough default } default: { // %read_file_go_chr(acc, h, t) diff --git a/clang/prim/fn/write_bytes.c b/clang/prim/fn/write_bytes.c index 3ab541d8..e9d0d7fc 100644 --- a/clang/prim/fn/write_bytes.c +++ b/clang/prim/fn/write_bytes.c @@ -83,11 +83,7 @@ fn Term write_bytes_go_path(Term *args) { } // %write_bytes_go_path(acc, x, data) // ----------------------------------- write-bytes-go-path-fallback - // %write_bytes_go_io(acc(x), data) - Term path = term_new_app(acc, list_wnf); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); - return wnf(io); + // fallthrough default } default: { // %write_bytes_go_path(acc, x, data) @@ -167,13 +163,7 @@ fn Term write_bytes_go_chr(Term *args) { } // %write_bytes_go_chr(acc, h, t, data) // ------------------------------------- write-bytes-go-chr-fallback - // %write_bytes_go_io(acc(#Con{h, t}), data) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); - return wnf(io); + // fallthrough default } default: { // %write_bytes_go_chr(acc, h, t, data) diff --git a/clang/prim/fn/write_file.c b/clang/prim/fn/write_file.c index dadcdbc3..c30eaf91 100644 --- a/clang/prim/fn/write_file.c +++ b/clang/prim/fn/write_file.c @@ -83,11 +83,7 @@ fn Term write_file_go_path(Term *args) { } // %write_file_go_path(acc, x, data) // ---------------------------------- write-file-go-path-fallback - // %write_file_go_io(acc(x), data) - Term path = term_new_app(acc, list_wnf); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); - return wnf(io); + // fallthrough default } default: { // %write_file_go_path(acc, x, data) @@ -167,13 +163,7 @@ fn Term write_file_go_chr(Term *args) { } // %write_file_go_chr(acc, h, t, data) // ------------------------------------ write-file-go-chr-fallback - // %write_file_go_io(acc(#Con{h, t}), data) - Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); - Term path = term_new_app(acc, con); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); - return wnf(io); + // fallthrough default } default: { // %write_file_go_chr(acc, h, t, data) From 696db0548e5b1ddcdd952111baedcd12afc02b69 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Tue, 10 Feb 2026 16:06:08 +0400 Subject: [PATCH 13/35] 2 arg prims also deal with INC/ERA/SUP --- clang/prim/fn/write_bytes.c | 295 +++++++++++++++++++++++++++-- clang/prim/fn/write_file.c | 367 +++++++++++++++++++++++++++++++----- 2 files changed, 600 insertions(+), 62 deletions(-) diff --git a/clang/prim/fn/write_bytes.c b/clang/prim/fn/write_bytes.c index e9d0d7fc..a1f5d99a 100644 --- a/clang/prim/fn/write_bytes.c +++ b/clang/prim/fn/write_bytes.c @@ -1,6 +1,9 @@ fn Term write_bytes_go_path(Term *args); fn Term write_bytes_go_chr(Term *args); fn Term write_bytes_go_num(Term *args); +fn Term write_bytes_go_data(Term *args); +fn Term write_bytes_go_data_byt(Term *args); +fn Term write_bytes_go_data_num(Term *args); // %write_bytes(path, data) // ------------------------ @@ -63,12 +66,15 @@ fn Term write_bytes_go_path(Term *args) { if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { // %write_bytes_go_path(acc, #Nil, data) // -------------------------------------- write-bytes-go-path-nil - // %write_bytes_go_io(acc(#Nil), data) + // %write_bytes_go_data(acc(#Nil), λx.x, data) Term nil = term_new_ctr(NAM_NIL, 0, 0); Term path = term_new_app(acc, nil); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); - return wnf(io); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_bytes_go_data", 19), 3, args0); + return wnf(t); } if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { // %write_bytes_go_path(acc, #Con{h,t}, data) @@ -88,11 +94,14 @@ fn Term write_bytes_go_path(Term *args) { default: { // %write_bytes_go_path(acc, x, data) // ----------------------------------- write-bytes-go-path-default - // %write_bytes_go_io(acc(x), data) + // %write_bytes_go_data(acc(x), λx.x, data) Term path = term_new_app(acc, list_wnf); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); - return wnf(io); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_bytes_go_data", 19), 3, args0); + return wnf(t); } } } @@ -168,13 +177,16 @@ fn Term write_bytes_go_chr(Term *args) { default: { // %write_bytes_go_chr(acc, h, t, data) // ------------------------------------- write-bytes-go-chr-default - // %write_bytes_go_io(acc(#Con{h, t}), data) + // %write_bytes_go_data(acc(#Con{h, t}), λx.x, data) Term con_args[2] = {head_wnf, tail}; Term con = term_new_ctr(NAM_CON, 2, con_args); Term path = term_new_app(acc, con); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); - return wnf(io); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_bytes_go_data", 19), 3, args0); + return wnf(t); } } } @@ -253,11 +265,265 @@ fn Term write_bytes_go_num(Term *args) { default: { // %write_bytes_go_num(acc, c, t, data) // ------------------------------------- write-bytes-go-num-default - // %write_bytes_go_io(acc(#Con{#Chr{c}, t}), data) + // %write_bytes_go_data(acc(#Con{#Chr{c}, t}), λx.x, data) Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; Term con = term_new_ctr(NAM_CON, 2, con_args); Term path = term_new_app(acc, con); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_bytes_go_data", 19), 3, args0); + return wnf(t); + } + } +} + +// %write_bytes_go_data(path, acc, list) +// ------------------------------------- +// Walk data list shape with lifting over ERA/INC/SUP. +fn Term write_bytes_go_data(Term *args) { + Term path = args[0]; + Term acc = args[1]; + Term list_wnf = wnf(args[2]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %write_bytes_go_data(path, acc, &{}) + // ------------------------------------ write-bytes-go-data-era + // &{} + return term_new_era(); + } + case INC: { + // %write_bytes_go_data(path, acc, ↑x) + // ----------------------------------- write-bytes-go-data-inc + // ↑(%write_bytes(path, acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term data = term_new_app(acc, inner); + Term next_args[2] = {path, data}; + Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_bytes_go_data(path, acc, &L{x,y}) + // ---------------------------------------- write-bytes-go-data-sup + // &L{%write_bytes(path0, acc0(x)), %write_bytes(path1, acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy P = term_clone(lab, path); + Copy A = term_clone(lab, acc); + Term data0 = term_new_app(A.k0, x); + Term data1 = term_new_app(A.k1, y); + Term args0[2] = {P.k0, data0}; + Term args1[2] = {P.k1, data1}; + Term t0 = term_new_pri(table_find("write_bytes", 11), 2, args0); + Term t1 = term_new_pri(table_find("write_bytes", 11), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %write_bytes_go_data(path, acc, #Nil) + // ------------------------------------- write-bytes-go-data-nil + // %write_bytes_go_io(path, acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term data = term_new_app(acc, nil); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %write_bytes_go_data(path, acc, #Con{h,t}) + // ------------------------------------------ write-bytes-go-data-con + // %write_bytes_go_data_byt(path, acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[4] = {path, acc, head, tail}; + Term t = term_new_pri(table_find("write_bytes_go_data_byt", 23), 4, args0); + return wnf(t); + } + // %write_bytes_go_data(path, acc, x) + // ----------------------------------- write-bytes-go-data-fallback + // fallthrough default + } + default: { + // %write_bytes_go_data(path, acc, x) + // ----------------------------------- write-bytes-go-data-default + // %write_bytes_go_io(path, acc(x)) + Term data = term_new_app(acc, list_wnf); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + } +} + +// %write_bytes_go_data_byt(path, acc, head, tail) +// ------------------------------------------------ +// Lift head over ERA/INC/SUP; on concrete #BYT{code}, continue with `code`. +fn Term write_bytes_go_data_byt(Term *args) { + Term path = args[0]; + Term acc = args[1]; + Term head_wnf = wnf(args[2]); + Term tail = args[3]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %write_bytes_go_data_byt(path, acc, &{}, t) + // -------------------------------------------- write-bytes-go-data-byt-era + // &{} + return term_new_era(); + } + case INC: { + // %write_bytes_go_data_byt(path, acc, ↑x, t) + // ------------------------------------------- write-bytes-go-data-byt-inc + // ↑(%write_bytes(path, acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); + Term next_args[2] = {path, data}; + Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_bytes_go_data_byt(path, acc, &L{x,y}, t) + // ------------------------------------------------ write-bytes-go-data-byt-sup + // &L{%write_bytes(path0, acc0(#Con{x, t0})), %write_bytes(path1, acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy P = term_clone(lab, path); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term data0 = term_new_app(A.k0, con0); + Term data1 = term_new_app(A.k1, con1); + Term args0[2] = {P.k0, data0}; + Term args1[2] = {P.k1, data1}; + Term t0 = term_new_pri(table_find("write_bytes", 11), 2, args0); + Term t1 = term_new_pri(table_find("write_bytes", 11), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_BYT) { + // %write_bytes_go_data_byt(path, acc, #BYT{c}, t) + // ------------------------------------------------ write-bytes-go-data-byt-byt + // %write_bytes_go_data_num(path, acc, c, t) + u32 byt_loc = term_val(head_wnf); + Term code = heap_read(byt_loc + 0); + Term args0[4] = {path, acc, code, tail}; + Term t = term_new_pri(table_find("write_bytes_go_data_num", 23), 4, args0); + return wnf(t); + } + // %write_bytes_go_data_byt(path, acc, h, t) + // ------------------------------------------ write-bytes-go-data-byt-fallback + // fallthrough default + } + default: { + // %write_bytes_go_data_byt(path, acc, h, t) + // ------------------------------------------ write-bytes-go-data-byt-default + // %write_bytes_go_io(path, acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); + return wnf(io); + } + } +} + +// %write_bytes_go_data_num(path, acc, code, tail) +// ------------------------------------------------ +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term write_bytes_go_data_num(Term *args) { + Term path = args[0]; + Term acc = args[1]; + Term code_wnf = wnf(args[2]); + Term tail = args[3]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %write_bytes_go_data_num(path, acc, &{}, t) + // -------------------------------------------- write-bytes-go-data-num-era + // &{} + return term_new_era(); + } + case INC: { + // %write_bytes_go_data_num(path, acc, ↑x, t) + // ------------------------------------------- write-bytes-go-data-num-inc + // ↑(%write_bytes(path, acc(#Con{#BYT{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term byt = term_new_ctr(NAM_BYT, 1, &inner); + Term con_args[2] = {byt, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); + Term next_args[2] = {path, data}; + Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_bytes_go_data_num(path, acc, &L{x,y}, t) + // ------------------------------------------------ write-bytes-go-data-num-sup + // &L{%write_bytes(path0, acc0(#Con{#BYT{x}, t0})), %write_bytes(path1, acc1(#Con{#BYT{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy P = term_clone(lab, path); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term byt0 = term_new_ctr(NAM_BYT, 1, &x); + Term byt1 = term_new_ctr(NAM_BYT, 1, &y); + Term con0_args[2] = {byt0, T.k0}; + Term con1_args[2] = {byt1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term data0 = term_new_app(A.k0, con0); + Term data1 = term_new_app(A.k1, con1); + Term args0[2] = {P.k0, data0}; + Term args1[2] = {P.k1, data1}; + Term t0 = term_new_pri(table_find("write_bytes", 11), 2, args0); + Term t1 = term_new_pri(table_find("write_bytes", 11), 2, args1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %write_bytes_go_data_num(path, acc, n, t) + // ------------------------------------------ write-bytes-go-data-num-num + // %write_bytes_go_data(path, λx.acc(#Con{#BYT{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term byt = term_new_ctr(NAM_BYT, 1, &code_wnf); + Term con_args[2] = {byt, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[3] = {path, acc_next, tail}; + Term t = term_new_pri(table_find("write_bytes_go_data", 19), 3, args0); + return wnf(t); + } + default: { + // %write_bytes_go_data_num(path, acc, c, t) + // ------------------------------------------ write-bytes-go-data-num-default + // %write_bytes_go_io(path, acc(#Con{#BYT{c}, t})) + Term byt = term_new_ctr(NAM_BYT, 1, &code_wnf); + Term con_args[2] = {byt, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); return wnf(io); @@ -366,5 +632,8 @@ fn void prim_write_bytes_init(void) { prim_register("write_bytes_go_path", 19, 3, write_bytes_go_path); prim_register("write_bytes_go_chr", 18, 4, write_bytes_go_chr); prim_register("write_bytes_go_num", 18, 4, write_bytes_go_num); + prim_register("write_bytes_go_data", 19, 3, write_bytes_go_data); + prim_register("write_bytes_go_data_byt", 23, 4, write_bytes_go_data_byt); + prim_register("write_bytes_go_data_num", 23, 4, write_bytes_go_data_num); prim_register("write_bytes_go_io", 17, 2, prim_fn_write_bytes_go_io); } diff --git a/clang/prim/fn/write_file.c b/clang/prim/fn/write_file.c index c30eaf91..140953f1 100644 --- a/clang/prim/fn/write_file.c +++ b/clang/prim/fn/write_file.c @@ -1,6 +1,9 @@ fn Term write_file_go_path(Term *args); -fn Term write_file_go_chr(Term *args); -fn Term write_file_go_num(Term *args); +fn Term write_file_go_path_chr(Term *args); +fn Term write_file_go_path_num(Term *args); +fn Term write_file_go_data(Term *args); +fn Term write_file_go_data_chr(Term *args); +fn Term write_file_go_data_num(Term *args); // %write_file(path, data) // ----------------------- @@ -63,22 +66,25 @@ fn Term write_file_go_path(Term *args) { if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { // %write_file_go_path(acc, #Nil, data) // ------------------------------------- write-file-go-path-nil - // %write_file_go_io(acc(#Nil), data) + // %write_file_go_data(acc(#Nil), λx.x, data) Term nil = term_new_ctr(NAM_NIL, 0, 0); Term path = term_new_app(acc, nil); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); - return wnf(io); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_file_go_data", 18), 3, args0); + return wnf(t); } if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { // %write_file_go_path(acc, #Con{h,t}, data) // ------------------------------------------ write-file-go-path-con - // %write_file_go_chr(acc, h, t, data) + // %write_file_go_path_chr(acc, h, t, data) u32 con_loc = term_val(list_wnf); Term head = heap_read(con_loc + 0); Term tail = heap_read(con_loc + 1); Term args0[4] = {acc, head, tail, data}; - Term t = term_new_pri(table_find("write_file_go_chr", 17), 4, args0); + Term t = term_new_pri(table_find("write_file_go_path_chr", 22), 4, args0); return wnf(t); } // %write_file_go_path(acc, x, data) @@ -88,19 +94,22 @@ fn Term write_file_go_path(Term *args) { default: { // %write_file_go_path(acc, x, data) // ---------------------------------- write-file-go-path-default - // %write_file_go_io(acc(x), data) + // %write_file_go_data(acc(x), λx.x, data) Term path = term_new_app(acc, list_wnf); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); - return wnf(io); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_file_go_data", 18), 3, args0); + return wnf(t); } } } -// %write_file_go_chr(acc, head, tail, data) -// ------------------------------------------ +// %write_file_go_path_chr(acc, head, tail, data) +// ----------------------------------------------- // Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. -fn Term write_file_go_chr(Term *args) { +fn Term write_file_go_path_chr(Term *args) { Term acc = args[0]; Term head_wnf = wnf(args[1]); Term tail = args[2]; @@ -108,14 +117,14 @@ fn Term write_file_go_chr(Term *args) { switch (term_tag(head_wnf)) { case ERA: { - // %write_file_go_chr(acc, &{}, t, data) - // -------------------------------------- write-file-go-chr-era + // %write_file_go_path_chr(acc, &{}, t, data) + // ------------------------------------------- write-file-go-path-chr-era // &{} return term_new_era(); } case INC: { - // %write_file_go_chr(acc, ↑x, t, data) - // ------------------------------------- write-file-go-chr-inc + // %write_file_go_path_chr(acc, ↑x, t, data) + // ------------------------------------------ write-file-go-path-chr-inc // ↑(%write_file(acc(#Con{x, t}), data)) u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); @@ -128,8 +137,8 @@ fn Term write_file_go_chr(Term *args) { return term_new(0, INC, 0, inc_loc); } case SUP: { - // %write_file_go_chr(acc, &L{x,y}, t, data) - // ------------------------------------------ write-file-go-chr-sup + // %write_file_go_path_chr(acc, &L{x,y}, t, data) + // ----------------------------------------------- write-file-go-path-chr-sup // &L{%write_file(acc0(#Con{x, t0}), data0), %write_file(acc1(#Con{y, t1}), data1)} u32 lab = term_ext(head_wnf); u32 sup_loc = term_val(head_wnf); @@ -152,37 +161,40 @@ fn Term write_file_go_chr(Term *args) { } case C00 ... C16: { if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { - // %write_file_go_chr(acc, #Chr{c}, t, data) - // ------------------------------------------ write-file-go-chr-chr - // %write_file_go_num(acc, c, t, data) + // %write_file_go_path_chr(acc, #Chr{c}, t, data) + // ----------------------------------------------- write-file-go-path-chr-chr + // %write_file_go_path_num(acc, c, t, data) u32 chr_loc = term_val(head_wnf); Term code = heap_read(chr_loc + 0); Term args0[4] = {acc, code, tail, data}; - Term t = term_new_pri(table_find("write_file_go_num", 17), 4, args0); + Term t = term_new_pri(table_find("write_file_go_path_num", 22), 4, args0); return wnf(t); } - // %write_file_go_chr(acc, h, t, data) - // ------------------------------------ write-file-go-chr-fallback + // %write_file_go_path_chr(acc, h, t, data) + // ----------------------------------------- write-file-go-path-chr-fallback // fallthrough default } default: { - // %write_file_go_chr(acc, h, t, data) - // ------------------------------------ write-file-go-chr-default - // %write_file_go_io(acc(#Con{h, t}), data) + // %write_file_go_path_chr(acc, h, t, data) + // ----------------------------------------- write-file-go-path-chr-default + // %write_file_go_data(acc(#Con{h, t}), λx.x, data) Term con_args[2] = {head_wnf, tail}; Term con = term_new_ctr(NAM_CON, 2, con_args); Term path = term_new_app(acc, con); - Term io_args[2] = {path, data}; - Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); - return wnf(io); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_file_go_data", 18), 3, args0); + return wnf(t); } } } -// %write_file_go_num(acc, code, tail, data) -// ------------------------------------------ +// %write_file_go_path_num(acc, code, tail, data) +// ----------------------------------------------- // Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. -fn Term write_file_go_num(Term *args) { +fn Term write_file_go_path_num(Term *args) { Term acc = args[0]; Term code_wnf = wnf(args[1]); Term tail = args[2]; @@ -190,14 +202,14 @@ fn Term write_file_go_num(Term *args) { switch (term_tag(code_wnf)) { case ERA: { - // %write_file_go_num(acc, &{}, t, data) - // -------------------------------------- write-file-go-num-era + // %write_file_go_path_num(acc, &{}, t, data) + // ------------------------------------------- write-file-go-path-num-era // &{} return term_new_era(); } case INC: { - // %write_file_go_num(acc, ↑x, t, data) - // ------------------------------------- write-file-go-num-inc + // %write_file_go_path_num(acc, ↑x, t, data) + // ------------------------------------------ write-file-go-path-num-inc // ↑(%write_file(acc(#Con{#Chr{x}, t}), data)) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); @@ -211,8 +223,8 @@ fn Term write_file_go_num(Term *args) { return term_new(0, INC, 0, inc_loc); } case SUP: { - // %write_file_go_num(acc, &L{x,y}, t, data) - // ------------------------------------------ write-file-go-num-sup + // %write_file_go_path_num(acc, &L{x,y}, t, data) + // ----------------------------------------------- write-file-go-path-num-sup // &L{%write_file(acc0(#Con{#Chr{x}, t0}), data0), %write_file(acc1(#Con{#Chr{y}, t1}), data1)} u32 lab = term_ext(code_wnf); u32 sup_loc = term_val(code_wnf); @@ -236,8 +248,8 @@ fn Term write_file_go_num(Term *args) { return term_new_sup(lab, t0, t1); } case NUM: { - // %write_file_go_num(acc, n, t, data) - // ------------------------------------ write-file-go-num-num + // %write_file_go_path_num(acc, n, t, data) + // ----------------------------------------- write-file-go-path-num-num // %write_file_go_path(λx.acc(#Con{#Chr{n}, x}), t, data) u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -251,13 +263,267 @@ fn Term write_file_go_num(Term *args) { return wnf(t); } default: { - // %write_file_go_num(acc, c, t, data) - // ------------------------------------ write-file-go-num-default - // %write_file_go_io(acc(#Con{#Chr{c}, t}), data) + // %write_file_go_path_num(acc, c, t, data) + // ----------------------------------------- write-file-go-path-num-default + // %write_file_go_data(acc(#Con{#Chr{c}, t}), λx.x, data) Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; Term con = term_new_ctr(NAM_CON, 2, con_args); Term path = term_new_app(acc, con); + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term data_acc = term_new_lam_at(loc, var); + Term args0[3] = {path, data_acc, data}; + Term t = term_new_pri(table_find("write_file_go_data", 18), 3, args0); + return wnf(t); + } + } +} + +// %write_file_go_data(path, acc, list) +// ------------------------------------ +// Walk data list shape with lifting over ERA/INC/SUP. +fn Term write_file_go_data(Term *args) { + Term path = args[0]; + Term acc = args[1]; + Term list_wnf = wnf(args[2]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %write_file_go_data(path, acc, &{}) + // ----------------------------------- write-file-go-data-era + // &{} + return term_new_era(); + } + case INC: { + // %write_file_go_data(path, acc, ↑x) + // ---------------------------------- write-file-go-data-inc + // ↑(%write_file(path, acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term data = term_new_app(acc, inner); + Term next_args[2] = {path, data}; + Term next = term_new_pri(table_find("write_file", 10), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_file_go_data(path, acc, &L{x,y}) + // --------------------------------------- write-file-go-data-sup + // &L{%write_file(path0, acc0(x)), %write_file(path1, acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy P = term_clone(lab, path); + Copy A = term_clone(lab, acc); + Term data0 = term_new_app(A.k0, x); + Term data1 = term_new_app(A.k1, y); + Term args0[2] = {P.k0, data0}; + Term args1[2] = {P.k1, data1}; + Term t0 = term_new_pri(table_find("write_file", 10), 2, args0); + Term t1 = term_new_pri(table_find("write_file", 10), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %write_file_go_data(path, acc, #Nil) + // ------------------------------------ write-file-go-data-nil + // %write_file_go_io(path, acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term data = term_new_app(acc, nil); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %write_file_go_data(path, acc, #Con{h,t}) + // ----------------------------------------- write-file-go-data-con + // %write_file_go_data_chr(path, acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[4] = {path, acc, head, tail}; + Term t = term_new_pri(table_find("write_file_go_data_chr", 22), 4, args0); + return wnf(t); + } + // %write_file_go_data(path, acc, x) + // ---------------------------------- write-file-go-data-fallback + // fallthrough default + } + default: { + // %write_file_go_data(path, acc, x) + // ---------------------------------- write-file-go-data-default + // %write_file_go_io(path, acc(x)) + Term data = term_new_app(acc, list_wnf); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + } +} + +// %write_file_go_data_chr(path, acc, head, tail) +// ----------------------------------------------- +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term write_file_go_data_chr(Term *args) { + Term path = args[0]; + Term acc = args[1]; + Term head_wnf = wnf(args[2]); + Term tail = args[3]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %write_file_go_data_chr(path, acc, &{}, t) + // ------------------------------------------- write-file-go-data-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %write_file_go_data_chr(path, acc, ↑x, t) + // ------------------------------------------ write-file-go-data-chr-inc + // ↑(%write_file(path, acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); + Term next_args[2] = {path, data}; + Term next = term_new_pri(table_find("write_file", 10), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_file_go_data_chr(path, acc, &L{x,y}, t) + // ----------------------------------------------- write-file-go-data-chr-sup + // &L{%write_file(path0, acc0(#Con{x, t0})), %write_file(path1, acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy P = term_clone(lab, path); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term data0 = term_new_app(A.k0, con0); + Term data1 = term_new_app(A.k1, con1); + Term args0[2] = {P.k0, data0}; + Term args1[2] = {P.k1, data1}; + Term t0 = term_new_pri(table_find("write_file", 10), 2, args0); + Term t1 = term_new_pri(table_find("write_file", 10), 2, args1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %write_file_go_data_chr(path, acc, #Chr{c}, t) + // ----------------------------------------------- write-file-go-data-chr-chr + // %write_file_go_data_num(path, acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[4] = {path, acc, code, tail}; + Term t = term_new_pri(table_find("write_file_go_data_num", 22), 4, args0); + return wnf(t); + } + // %write_file_go_data_chr(path, acc, h, t) + // ----------------------------------------- write-file-go-data-chr-fallback + // fallthrough default + } + default: { + // %write_file_go_data_chr(path, acc, h, t) + // ----------------------------------------- write-file-go-data-chr-default + // %write_file_go_io(path, acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); + Term io_args[2] = {path, data}; + Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); + return wnf(io); + } + } +} + +// %write_file_go_data_num(path, acc, code, tail) +// ----------------------------------------------- +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term write_file_go_data_num(Term *args) { + Term path = args[0]; + Term acc = args[1]; + Term code_wnf = wnf(args[2]); + Term tail = args[3]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %write_file_go_data_num(path, acc, &{}, t) + // ------------------------------------------- write-file-go-data-num-era + // &{} + return term_new_era(); + } + case INC: { + // %write_file_go_data_num(path, acc, ↑x, t) + // ------------------------------------------ write-file-go-data-num-inc + // ↑(%write_file(path, acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); + Term next_args[2] = {path, data}; + Term next = term_new_pri(table_find("write_file", 10), 2, next_args); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %write_file_go_data_num(path, acc, &L{x,y}, t) + // ----------------------------------------------- write-file-go-data-num-sup + // &L{%write_file(path0, acc0(#Con{#Chr{x}, t0})), %write_file(path1, acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy P = term_clone(lab, path); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term data0 = term_new_app(A.k0, con0); + Term data1 = term_new_app(A.k1, con1); + Term args0[2] = {P.k0, data0}; + Term args1[2] = {P.k1, data1}; + Term t0 = term_new_pri(table_find("write_file", 10), 2, args0); + Term t1 = term_new_pri(table_find("write_file", 10), 2, args1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %write_file_go_data_num(path, acc, n, t) + // ----------------------------------------- write-file-go-data-num-num + // %write_file_go_data(path, λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[3] = {path, acc_next, tail}; + Term t = term_new_pri(table_find("write_file_go_data", 18), 3, args0); + return wnf(t); + } + default: { + // %write_file_go_data_num(path, acc, c, t) + // ----------------------------------------- write-file-go-data-num-default + // %write_file_go_io(path, acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term data = term_new_app(acc, con); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); return wnf(io); @@ -365,7 +631,10 @@ fn Term prim_fn_write_file_go_io(Term *args) { fn void prim_write_file_init(void) { prim_register("write_file", 10, 2, prim_fn_write_file); prim_register("write_file_go_path", 18, 3, write_file_go_path); - prim_register("write_file_go_chr", 17, 4, write_file_go_chr); - prim_register("write_file_go_num", 17, 4, write_file_go_num); + prim_register("write_file_go_path_chr", 22, 4, write_file_go_path_chr); + prim_register("write_file_go_path_num", 22, 4, write_file_go_path_num); + prim_register("write_file_go_data", 18, 3, write_file_go_data); + prim_register("write_file_go_data_chr", 22, 4, write_file_go_data_chr); + prim_register("write_file_go_data_num", 22, 4, write_file_go_data_num); prim_register("write_file_go_io", 16, 2, prim_fn_write_file_go_io); } From 1437969d6b8bb0aec2406a267365c87c945399d0 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Tue, 10 Feb 2026 16:26:13 +0400 Subject: [PATCH 14/35] env prim --- clang/prim/fn/env.c | 282 ++++++++++++++++++++++++++++++++++++++++++++ clang/prim/init.c | 1 + 2 files changed, 283 insertions(+) create mode 100644 clang/prim/fn/env.c diff --git a/clang/prim/fn/env.c b/clang/prim/fn/env.c new file mode 100644 index 00000000..000821f0 --- /dev/null +++ b/clang/prim/fn/env.c @@ -0,0 +1,282 @@ +fn Term env_go_name(Term *args); +fn Term env_go_chr(Term *args); +fn Term env_go_num(Term *args); + +// %env(name) +// ---------- +// %env_go_name(λx.x, name) +fn Term prim_fn_env(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("env_go_name", 11), 2, args0); + return wnf(t); +} + +// %env_go_name(acc, list) +// ----------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term env_go_name(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %env_go_name(acc, &{}) + // ---------------------- env-go-name-era + // &{} + return term_new_era(); + } + case INC: { + // %env_go_name(acc, ↑x) + // --------------------- env-go-name-inc + // ↑(%env(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("env", 3), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %env_go_name(acc, &L{x,y}) + // -------------------------- env-go-name-sup + // &L{%env(acc0(x)), %env(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("env", 3), 1, &app0); + Term t1 = term_new_pri(table_find("env", 3), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %env_go_name(acc, #Nil) + // ----------------------- env-go-name-nil + // %env_go_io(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term name = term_new_app(acc, nil); + Term io_args[1] = {name}; + Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %env_go_name(acc, #Con{h,t}) + // ---------------------------- env-go-name-con + // %env_go_chr(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("env_go_chr", 10), 3, args0); + return wnf(t); + } + // %env_go_name(acc, x) + // --------------------- env-go-name-fallback + // fallthrough default + } + default: { + // %env_go_name(acc, x) + // --------------------- env-go-name-default + // %env_go_io(acc(x)) + Term name = term_new_app(acc, list_wnf); + Term io_args[1] = {name}; + Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); + return wnf(io); + } + } +} + +// %env_go_chr(acc, head, tail) +// ---------------------------- +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term env_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %env_go_chr(acc, &{}, t) + // ------------------------ env-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %env_go_chr(acc, ↑x, t) + // ----------------------- env-go-chr-inc + // ↑(%env(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("env", 3), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %env_go_chr(acc, &L{x,y}, t) + // ---------------------------- env-go-chr-sup + // &L{%env(acc0(#Con{x, t0})), %env(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("env", 3), 1, &app0); + Term t1 = term_new_pri(table_find("env", 3), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %env_go_chr(acc, #Chr{c}, t) + // ---------------------------- env-go-chr-chr + // %env_go_num(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("env_go_num", 10), 3, args0); + return wnf(t); + } + // %env_go_chr(acc, h, t) + // ----------------------- env-go-chr-fallback + // fallthrough default + } + default: { + // %env_go_chr(acc, h, t) + // ----------------------- env-go-chr-default + // %env_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term name = term_new_app(acc, con); + Term io_args[1] = {name}; + Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); + return wnf(io); + } + } +} + +// %env_go_num(acc, code, tail) +// ---------------------------- +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term env_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %env_go_num(acc, &{}, t) + // ------------------------ env-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %env_go_num(acc, ↑x, t) + // ----------------------- env-go-num-inc + // ↑(%env(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("env", 3), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %env_go_num(acc, &L{x,y}, t) + // ---------------------------- env-go-num-sup + // &L{%env(acc0(#Con{#Chr{x}, t0})), %env(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("env", 3), 1, &app0); + Term t1 = term_new_pri(table_find("env", 3), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %env_go_num(acc, n, t) + // ----------------------- env-go-num-num + // %env_go_name(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("env_go_name", 11), 2, args0); + return wnf(t); + } + default: { + // %env_go_num(acc, c, t) + // ----------------------- env-go-num-default + // %env_go_io(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term name = term_new_app(acc, con); + Term io_args[1] = {name}; + Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); + return wnf(io); + } + } +} + +// %env_go_io(name) +// ---------------- +// #OK{String} | #ERR{String} +fn Term prim_fn_env_go_io(Term *args) { + int MAX_NAME = 1024; + char name[MAX_NAME]; // UTF-8 bytes + const char *NOT_FOUND_FMT = "ERROR(env): variable '%s' not found"; + + // Decode HVM env name string (#CHR list) into `name` as UTF-8 bytes. + HStrErr name_err; + if (!term_string_to_utf8_cstr(args[0], name, MAX_NAME, NULL, &name_err)) { + return term_string_from_hstrerr("env", "name", MAX_NAME, name_err); + } + + const char *value = getenv(name); + if (value == NULL) { + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(NOT_FOUND_FMT, name) }); + } + + Term out = term_string_from_utf8(value); + return term_new_ctr(NAM_OK, 1, &out); +} + +fn void prim_env_init(void) { + prim_register("env", 3, 1, prim_fn_env); + prim_register("env_go_name", 11, 2, env_go_name); + prim_register("env_go_chr", 10, 3, env_go_chr); + prim_register("env_go_num", 10, 3, env_go_num); + prim_register("env_go_io", 9, 1, prim_fn_env_go_io); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 27a99a15..0497668c 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -4,6 +4,7 @@ fn void prim_init(void) { prim_rand_init(); prim_process_init(); prim_timer_init(); + prim_env_init(); prim_read_bytes_init(); prim_write_bytes_init(); prim_read_file_init(); From 0e17e92d781a5fae5035b4c12f70bc7c1056f0d8 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Tue, 10 Feb 2026 16:29:19 +0400 Subject: [PATCH 15/35] env in hvm4.c --- clang/hvm.c | 1 + 1 file changed, 1 insertion(+) diff --git a/clang/hvm.c b/clang/hvm.c index 891f1642..ca763d6d 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -365,6 +365,7 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/log_go_1.c" #include "prim/fn/log_go_2.c" #include "prim/fn/panic.c" +#include "prim/fn/env.c" #include "prim/fn/rand.c" #include "prim/fn/process/_.c" #include "prim/fn/read_bytes.c" From e94bd6d9aac87221bfba85d66834873894b78787 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 10:03:38 -0300 Subject: [PATCH 16/35] stream prim --- clang/hvm.c | 1 + clang/prim/fn/stream/_.c | 226 ++++++++++++++++++++++++++ clang/prim/fn/stream/poll.c | 104 ++++++++++++ clang/prim/fn/stream/stdin_open.c | 84 ++++++++++ clang/prim/fn/stream/wait.c | 106 ++++++++++++ clang/prim/init.c | 1 + test/prim_stream_poll_bad_handle.hvm4 | 2 + test/prim_stream_poll_era.hvm4 | 2 + test/prim_stream_poll_open.hvm4 | 2 + test/prim_stream_poll_stale.hvm4 | 5 + test/prim_stream_poll_sup.hvm4 | 2 + test/prim_stream_stdin_open.hvm4 | 2 + test/prim_stream_stdin_open_era.hvm4 | 2 + test/prim_stream_stdin_open_inc.hvm4 | 2 + test/prim_stream_stdin_open_sup.hvm4 | 2 + test/prim_stream_wait_bad_handle.hvm4 | 2 + test/prim_stream_wait_era.hvm4 | 2 + test/prim_stream_wait_sup.hvm4 | 2 + 18 files changed, 549 insertions(+) create mode 100644 clang/prim/fn/stream/_.c create mode 100644 clang/prim/fn/stream/poll.c create mode 100644 clang/prim/fn/stream/stdin_open.c create mode 100644 clang/prim/fn/stream/wait.c create mode 100644 test/prim_stream_poll_bad_handle.hvm4 create mode 100644 test/prim_stream_poll_era.hvm4 create mode 100644 test/prim_stream_poll_open.hvm4 create mode 100644 test/prim_stream_poll_stale.hvm4 create mode 100644 test/prim_stream_poll_sup.hvm4 create mode 100644 test/prim_stream_stdin_open.hvm4 create mode 100644 test/prim_stream_stdin_open_era.hvm4 create mode 100644 test/prim_stream_stdin_open_inc.hvm4 create mode 100644 test/prim_stream_stdin_open_sup.hvm4 create mode 100644 test/prim_stream_wait_bad_handle.hvm4 create mode 100644 test/prim_stream_wait_era.hvm4 create mode 100644 test/prim_stream_wait_sup.hvm4 diff --git a/clang/hvm.c b/clang/hvm.c index ca763d6d..cd2e89d6 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -368,6 +368,7 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/env.c" #include "prim/fn/rand.c" #include "prim/fn/process/_.c" +#include "prim/fn/stream/_.c" #include "prim/fn/read_bytes.c" #include "prim/fn/write_bytes.c" #include "prim/fn/read_file.c" diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c new file mode 100644 index 00000000..d03c823a --- /dev/null +++ b/clang/prim/fn/stream/_.c @@ -0,0 +1,226 @@ +#include +#include + +#define STREAM_CAP (1u << 20) + +#define STREAM_ERR_BAD_ARG 1 +#define STREAM_ERR_BAD_HANDLE 2 +#define STREAM_ERR_STALE 3 +#define STREAM_ERR_FULL 4 +#define STREAM_ERR_IO 5 + +#define STREAM_KIND_STDIN 1 + +typedef struct { + u32 expected_seq; + u8 kind; + u8 closed; + int fd; +} StreamSlot; + +static StreamSlot STREAM_SLOTS[STREAM_CAP]; +static u32 STREAM_NEXT_ID = 1; +static pthread_mutex_t STREAM_LOCK = PTHREAD_MUTEX_INITIALIZER; + +static u32 STREAM_NAM_STRM = 0; +static u32 STREAM_NAM_PEND = 0; +static u32 STREAM_NAM_RDY = 0; +static u32 STREAM_NAM_BYT = 0; +static u32 STREAM_NAM_EOF = 0; + +fn Term wnf(Term term); + +fn Term stream_new_err(const char *prim, u32 code, const char *msg) { + Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); + return term_new_ctr(NAM_ERR, 1, &txt); +} + +fn Term stream_new_handle(u32 id, u32 seq) { + Term args[2] = {term_new_num(id), term_new_num(seq)}; + return term_new_ctr(STREAM_NAM_STRM, 2, args); +} + +fn Term stream_new_pend(u32 id, u32 seq) { + Term strm = stream_new_handle(id, seq); + return term_new_ctr(STREAM_NAM_PEND, 1, &strm); +} + +fn Term stream_new_byt(u32 byt) { + Term arg = term_new_num(byt); + return term_new_ctr(STREAM_NAM_BYT, 1, &arg); +} + +fn Term stream_new_eof(void) { + return term_new_ctr(STREAM_NAM_EOF, 0, NULL); +} + +fn Term stream_new_rdy_payload(u32 id, u32 seq, Term payload) { + Term strm = stream_new_handle(id, seq); + Term args[2] = {strm, payload}; + return term_new_ctr(STREAM_NAM_RDY, 2, args); +} + +fn Term stream_new_rdy_byt(u32 id, u32 seq, u32 byt) { + return stream_new_rdy_payload(id, seq, stream_new_byt(byt)); +} + +fn Term stream_new_rdy_eof(u32 id, u32 seq) { + return stream_new_rdy_payload(id, seq, stream_new_eof()); +} + +fn u8 stream_parse_num(Term term, u32 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case NUM: { + *out = term_val(val); + return 1; + } + default: { + return 0; + } + } +} + +fn u8 stream_parse_handle(Term term, u32 *id, u32 *seq) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C02: { + if (term_ext(val) != STREAM_NAM_STRM) { + return 0; + } + + u32 loc = term_val(val); + Term id_tm = heap_read(loc + 0); + Term seq_tm = heap_read(loc + 1); + + if (!stream_parse_num(id_tm, id)) { + return 0; + } + if (!stream_parse_num(seq_tm, seq)) { + return 0; + } + return 1; + } + default: { + return 0; + } + } +} + +fn u8 stream_is_valid_id(u32 id) { + pthread_mutex_lock(&STREAM_LOCK); + + if (id == 0 || id >= STREAM_NEXT_ID || id >= STREAM_CAP) { + pthread_mutex_unlock(&STREAM_LOCK); + return 0; + } + + pthread_mutex_unlock(&STREAM_LOCK); + return 1; +} + +fn u8 stream_claim(u32 id, u32 seq, u8 *kind, u8 *closed, int *fd) { + pthread_mutex_lock(&STREAM_LOCK); + + if (id == 0 || id >= STREAM_NEXT_ID || id >= STREAM_CAP) { + pthread_mutex_unlock(&STREAM_LOCK); + return 0; + } + + StreamSlot *slot = &STREAM_SLOTS[id]; + if (slot->expected_seq != seq) { + pthread_mutex_unlock(&STREAM_LOCK); + return 0; + } + + slot->expected_seq = seq + 1; + *kind = slot->kind; + *closed = slot->closed; + *fd = slot->fd; + + pthread_mutex_unlock(&STREAM_LOCK); + return 1; +} + +fn void stream_set_closed(u32 id) { + pthread_mutex_lock(&STREAM_LOCK); + + if (id != 0 && id < STREAM_NEXT_ID && id < STREAM_CAP) { + STREAM_SLOTS[id].closed = 1; + } + + pthread_mutex_unlock(&STREAM_LOCK); +} + +// Returns: +// 1 : ready (byte or eof) +// 0 : pending +// -1 : io error +fn int stream_stdin_read(int fd, int timeout_ms, u8 *out_byt, u8 *out_eof) { + *out_eof = 0; + + struct pollfd pfd = { + .fd = fd, + .events = POLLIN, + .revents = 0, + }; + + int poll_ret = 0; + while (1) { + poll_ret = poll(&pfd, 1, timeout_ms); + if (poll_ret >= 0) { + break; + } + if (errno == EINTR) { + continue; + } + return -1; + } + + if (poll_ret == 0) { + return 0; + } + + if ((pfd.revents & (POLLIN | POLLHUP | POLLERR)) == 0) { + return 0; + } + + while (1) { + u8 byt = 0; + ssize_t rd = read(fd, &byt, 1); + + if (rd == 1) { + *out_byt = byt; + return 1; + } + if (rd == 0) { + *out_eof = 1; + return 1; + } + if (errno == EINTR) { + continue; + } + if (errno == EAGAIN || errno == EWOULDBLOCK) { + return 0; + } + return -1; + } +} + +#include "stdin_open.c" +#include "poll.c" +#include "wait.c" + +fn void prim_stream_init(void) { + STREAM_NAM_STRM = nick_from_str("Strm", 4); + STREAM_NAM_PEND = nick_from_str("Pend", 4); + STREAM_NAM_RDY = nick_from_str("Rdy", 3); + STREAM_NAM_BYT = nick_from_str("Byt", 3); + STREAM_NAM_EOF = nick_from_str("Eof", 3); + + prim_stream_stdin_open_init(); + prim_stream_poll_init(); + prim_stream_wait_init(); +} diff --git a/clang/prim/fn/stream/poll.c b/clang/prim/fn/stream/poll.c new file mode 100644 index 00000000..bff9d8e0 --- /dev/null +++ b/clang/prim/fn/stream/poll.c @@ -0,0 +1,104 @@ +// %stream_poll(strm) +// ------------------ +// %stream_poll_go_strm(strm) +fn Term prim_fn_stream_poll(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("stream_poll_go_strm", 19), 1, args0); + return wnf(t); +} + +// %stream_poll_go_strm(strm) +// -------------------------- +// Lift `strm` over ERA/INC/SUP; default forwards to io stage. +fn Term stream_poll_go_strm(Term *args) { + Term strm_wnf = wnf(args[0]); + + switch (term_tag(strm_wnf)) { + case ERA: { + // %stream_poll_go_strm(&{}) + // ------------------------- stream-poll-go-strm-era + // &{} + return term_new_era(); + } + case INC: { + // %stream_poll_go_strm(↑x) + // ------------------------ stream-poll-go-strm-inc + // ↑(%stream_poll(x)) + u32 inc_loc = term_val(strm_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("stream_poll", 11), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %stream_poll_go_strm(&L{x,y}) + // ------------------------------ stream-poll-go-strm-sup + // &L{%stream_poll(x), %stream_poll(y)} + u32 lab = term_ext(strm_wnf); + u32 sup_loc = term_val(strm_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("stream_poll", 11), 1, &x); + Term t1 = term_new_pri(table_find("stream_poll", 11), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %stream_poll_go_strm(strm) + // -------------------------- stream-poll-go-strm-default + // %stream_poll_go_io(strm) + Term args0[1] = {strm_wnf}; + Term t = term_new_pri(table_find("stream_poll_go_io", 17), 1, args0); + return wnf(t); + } + } +} + +// %stream_poll_go_io(strm) +// ------------------------ +// #Pend{#Strm{id,seq+1}} | #Rdy{#Strm{id,seq+1},#Byt{n}|#Eof} | #ERR{String} +fn Term prim_fn_stream_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!stream_parse_handle(args[0], &id, &seq)) { + return stream_new_err("stream_poll", STREAM_ERR_BAD_HANDLE, "invalid `strm`; expected #Strm{id,seq}"); + } + + if (!stream_is_valid_id(id)) { + return stream_new_err("stream_poll", STREAM_ERR_BAD_HANDLE, "unknown stream id"); + } + + u8 kind = 0; + u8 closed = 0; + int fd = -1; + if (!stream_claim(id, seq, &kind, &closed, &fd)) { + return stream_new_err("stream_poll", STREAM_ERR_STALE, "stale stream handle"); + } + + if (closed) { + return stream_new_err("stream_poll", STREAM_ERR_BAD_HANDLE, "stream is closed"); + } + + if (kind != STREAM_KIND_STDIN) { + return stream_new_err("stream_poll", STREAM_ERR_BAD_HANDLE, "unsupported stream kind"); + } + + u8 byt = 0; + u8 eof = 0; + int read_ret = stream_stdin_read(fd, 0, &byt, &eof); + if (read_ret < 0) { + return stream_new_err("stream_poll", STREAM_ERR_IO, strerror(errno)); + } + if (read_ret == 0) { + return stream_new_pend(id, seq + 1); + } + if (eof) { + return stream_new_rdy_eof(id, seq + 1); + } + return stream_new_rdy_byt(id, seq + 1, byt); +} + +fn void prim_stream_poll_init(void) { + prim_register("stream_poll", 11, 1, prim_fn_stream_poll); + prim_register("stream_poll_go_strm", 19, 1, stream_poll_go_strm); + prim_register("stream_poll_go_io", 17, 1, prim_fn_stream_poll_go_io); +} diff --git a/clang/prim/fn/stream/stdin_open.c b/clang/prim/fn/stream/stdin_open.c new file mode 100644 index 00000000..ee8b40d7 --- /dev/null +++ b/clang/prim/fn/stream/stdin_open.c @@ -0,0 +1,84 @@ +// %stream_stdin_open(seed) +// ------------------------ +// %stream_stdin_open_go_seed(seed) +fn Term prim_fn_stream_stdin_open(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("stream_stdin_open_go_seed", 25), 1, args0); + return wnf(t); +} + +// %stream_stdin_open_go_seed(seed) +// -------------------------------- +// Lift `seed` over ERA/INC/SUP; default forwards to io stage. +fn Term stream_stdin_open_go_seed(Term *args) { + Term seed_wnf = wnf(args[0]); + + switch (term_tag(seed_wnf)) { + case ERA: { + // %stream_stdin_open_go_seed(&{}) + // ------------------------------- stream-stdin-open-go-seed-era + // &{} + return term_new_era(); + } + case INC: { + // %stream_stdin_open_go_seed(↑x) + // ------------------------------ stream-stdin-open-go-seed-inc + // ↑(%stream_stdin_open(x)) + u32 inc_loc = term_val(seed_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("stream_stdin_open", 17), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %stream_stdin_open_go_seed(&L{x,y}) + // ------------------------------------ stream-stdin-open-go-seed-sup + // &L{%stream_stdin_open(x), %stream_stdin_open(y)} + u32 lab = term_ext(seed_wnf); + u32 sup_loc = term_val(seed_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("stream_stdin_open", 17), 1, &x); + Term t1 = term_new_pri(table_find("stream_stdin_open", 17), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %stream_stdin_open_go_seed(seed) + // -------------------------------- stream-stdin-open-go-seed-default + // %stream_stdin_open_go_io(seed) + Term args0[1] = {seed_wnf}; + Term t = term_new_pri(table_find("stream_stdin_open_go_io", 23), 1, args0); + return wnf(t); + } + } +} + +// %stream_stdin_open_go_io(seed) +// ------------------------------- +// #Strm{id,0} | #ERR{String} +fn Term prim_fn_stream_stdin_open_go_io(Term *args) { + (void)args; + + pthread_mutex_lock(&STREAM_LOCK); + + u32 id = STREAM_NEXT_ID; + if (id >= STREAM_CAP) { + pthread_mutex_unlock(&STREAM_LOCK); + return stream_new_err("stream_stdin_open", STREAM_ERR_FULL, "stream table is full"); + } + + STREAM_NEXT_ID = id + 1; + STREAM_SLOTS[id].expected_seq = 0; + STREAM_SLOTS[id].kind = STREAM_KIND_STDIN; + STREAM_SLOTS[id].closed = 0; + STREAM_SLOTS[id].fd = 0; + + pthread_mutex_unlock(&STREAM_LOCK); + return stream_new_handle(id, 0); +} + +fn void prim_stream_stdin_open_init(void) { + prim_register("stream_stdin_open", 17, 1, prim_fn_stream_stdin_open); + prim_register("stream_stdin_open_go_seed", 25, 1, stream_stdin_open_go_seed); + prim_register("stream_stdin_open_go_io", 23, 1, prim_fn_stream_stdin_open_go_io); +} diff --git a/clang/prim/fn/stream/wait.c b/clang/prim/fn/stream/wait.c new file mode 100644 index 00000000..3cfbd97f --- /dev/null +++ b/clang/prim/fn/stream/wait.c @@ -0,0 +1,106 @@ +// %stream_wait(strm) +// ------------------ +// %stream_wait_go_strm(strm) +fn Term prim_fn_stream_wait(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("stream_wait_go_strm", 19), 1, args0); + return wnf(t); +} + +// %stream_wait_go_strm(strm) +// -------------------------- +// Lift `strm` over ERA/INC/SUP; default forwards to io stage. +fn Term stream_wait_go_strm(Term *args) { + Term strm_wnf = wnf(args[0]); + + switch (term_tag(strm_wnf)) { + case ERA: { + // %stream_wait_go_strm(&{}) + // ------------------------- stream-wait-go-strm-era + // &{} + return term_new_era(); + } + case INC: { + // %stream_wait_go_strm(↑x) + // ------------------------ stream-wait-go-strm-inc + // ↑(%stream_wait(x)) + u32 inc_loc = term_val(strm_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("stream_wait", 11), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %stream_wait_go_strm(&L{x,y}) + // ------------------------------ stream-wait-go-strm-sup + // &L{%stream_wait(x), %stream_wait(y)} + u32 lab = term_ext(strm_wnf); + u32 sup_loc = term_val(strm_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("stream_wait", 11), 1, &x); + Term t1 = term_new_pri(table_find("stream_wait", 11), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %stream_wait_go_strm(strm) + // -------------------------- stream-wait-go-strm-default + // %stream_wait_go_io(strm) + Term args0[1] = {strm_wnf}; + Term t = term_new_pri(table_find("stream_wait_go_io", 17), 1, args0); + return wnf(t); + } + } +} + +// %stream_wait_go_io(strm) +// ------------------------ +// #Rdy{#Strm{id,seq+1},#Byt{n}|#Eof} | #ERR{String} +fn Term prim_fn_stream_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!stream_parse_handle(args[0], &id, &seq)) { + return stream_new_err("stream_wait", STREAM_ERR_BAD_HANDLE, "invalid `strm`; expected #Strm{id,seq}"); + } + + if (!stream_is_valid_id(id)) { + return stream_new_err("stream_wait", STREAM_ERR_BAD_HANDLE, "unknown stream id"); + } + + u8 kind = 0; + u8 closed = 0; + int fd = -1; + if (!stream_claim(id, seq, &kind, &closed, &fd)) { + return stream_new_err("stream_wait", STREAM_ERR_STALE, "stale stream handle"); + } + + if (closed) { + return stream_new_err("stream_wait", STREAM_ERR_BAD_HANDLE, "stream is closed"); + } + + if (kind != STREAM_KIND_STDIN) { + return stream_new_err("stream_wait", STREAM_ERR_BAD_HANDLE, "unsupported stream kind"); + } + + while (1) { + u8 byt = 0; + u8 eof = 0; + int read_ret = stream_stdin_read(fd, -1, &byt, &eof); + if (read_ret < 0) { + return stream_new_err("stream_wait", STREAM_ERR_IO, strerror(errno)); + } + if (read_ret == 0) { + continue; + } + if (eof) { + return stream_new_rdy_eof(id, seq + 1); + } + return stream_new_rdy_byt(id, seq + 1, byt); + } +} + +fn void prim_stream_wait_init(void) { + prim_register("stream_wait", 11, 1, prim_fn_stream_wait); + prim_register("stream_wait_go_strm", 19, 1, stream_wait_go_strm); + prim_register("stream_wait_go_io", 17, 1, prim_fn_stream_wait_go_io); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 0497668c..362a4cda 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -3,6 +3,7 @@ fn void prim_init(void) { prim_panic_init(); prim_rand_init(); prim_process_init(); + prim_stream_init(); prim_timer_init(); prim_env_init(); prim_read_bytes_init(); diff --git a/test/prim_stream_poll_bad_handle.hvm4 b/test/prim_stream_poll_bad_handle.hvm4 new file mode 100644 index 00000000..67de0129 --- /dev/null +++ b/test/prim_stream_poll_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_poll(#Strm{1,0}) +//EXPECT_CONTAINS:E2 unknown stream id diff --git a/test/prim_stream_poll_era.hvm4 b/test/prim_stream_poll_era.hvm4 new file mode 100644 index 00000000..38d6d2d9 --- /dev/null +++ b/test/prim_stream_poll_era.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_poll(&{}) +//!&{} diff --git a/test/prim_stream_poll_open.hvm4 b/test/prim_stream_poll_open.hvm4 new file mode 100644 index 00000000..97a5e22b --- /dev/null +++ b/test/prim_stream_poll_open.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_poll(%stream_stdin_open(0)) +//EXPECT_CONTAINS:#Strm{1,1} diff --git a/test/prim_stream_poll_stale.hvm4 b/test/prim_stream_poll_stale.hvm4 new file mode 100644 index 00000000..d64251bb --- /dev/null +++ b/test/prim_stream_poll_stale.hvm4 @@ -0,0 +1,5 @@ +@main = + !!&s = %stream_stdin_open(0); + !!x = %stream_poll(s); + %stream_poll(s) +//EXPECT_CONTAINS:E3 stale stream handle diff --git a/test/prim_stream_poll_sup.hvm4 b/test/prim_stream_poll_sup.hvm4 new file mode 100644 index 00000000..56cd8850 --- /dev/null +++ b/test/prim_stream_poll_sup.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_poll(&L{&{},&{}}) +//!&L{&{},&{}} diff --git a/test/prim_stream_stdin_open.hvm4 b/test/prim_stream_stdin_open.hvm4 new file mode 100644 index 00000000..1ccece48 --- /dev/null +++ b/test/prim_stream_stdin_open.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_stdin_open(0) +//!#Strm{1,0} diff --git a/test/prim_stream_stdin_open_era.hvm4 b/test/prim_stream_stdin_open_era.hvm4 new file mode 100644 index 00000000..758f9607 --- /dev/null +++ b/test/prim_stream_stdin_open_era.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_stdin_open(&{}) +//!&{} diff --git a/test/prim_stream_stdin_open_inc.hvm4 b/test/prim_stream_stdin_open_inc.hvm4 new file mode 100644 index 00000000..d37ece39 --- /dev/null +++ b/test/prim_stream_stdin_open_inc.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_stdin_open(↑0) +//!↑#Strm{1,0} diff --git a/test/prim_stream_stdin_open_sup.hvm4 b/test/prim_stream_stdin_open_sup.hvm4 new file mode 100644 index 00000000..cc0fd8bd --- /dev/null +++ b/test/prim_stream_stdin_open_sup.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_stdin_open(&L{0,0}) +//!&L{#Strm{1,0},#Strm{2,0}} diff --git a/test/prim_stream_wait_bad_handle.hvm4 b/test/prim_stream_wait_bad_handle.hvm4 new file mode 100644 index 00000000..b0f40385 --- /dev/null +++ b/test/prim_stream_wait_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_wait(#Strm{1,0}) +//EXPECT_CONTAINS:E2 unknown stream id diff --git a/test/prim_stream_wait_era.hvm4 b/test/prim_stream_wait_era.hvm4 new file mode 100644 index 00000000..1aee455b --- /dev/null +++ b/test/prim_stream_wait_era.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_wait(&{}) +//!&{} diff --git a/test/prim_stream_wait_sup.hvm4 b/test/prim_stream_wait_sup.hvm4 new file mode 100644 index 00000000..eb71bf70 --- /dev/null +++ b/test/prim_stream_wait_sup.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_wait(&L{&{},&{}}) +//!&L{&{},&{}} From ecafd16347bf62412ce2c4a3b105a45e9dfa3d6f Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 10:32:33 -0300 Subject: [PATCH 17/35] standardizing responses --- clang/prim/fn/process/_.c | 4 ++++ clang/prim/fn/process/kill.c | 8 ++++---- clang/prim/fn/process/poll.c | 8 ++++---- clang/prim/fn/process/spawn.c | 4 ++-- clang/prim/fn/process/wait.c | 6 +++--- clang/prim/fn/stream/_.c | 4 ++++ clang/prim/fn/stream/poll.c | 8 ++++---- clang/prim/fn/stream/stdin_open.c | 4 ++-- clang/prim/fn/stream/wait.c | 6 +++--- clang/prim/fn/timer/_.c | 4 ++++ clang/prim/fn/timer/poll.c | 6 +++--- clang/prim/fn/timer/start.c | 4 ++-- clang/prim/fn/timer/wait.c | 4 ++-- 13 files changed, 41 insertions(+), 29 deletions(-) diff --git a/clang/prim/fn/process/_.c b/clang/prim/fn/process/_.c index 58e5aa37..f6861c2a 100644 --- a/clang/prim/fn/process/_.c +++ b/clang/prim/fn/process/_.c @@ -35,6 +35,10 @@ fn Term process_new_err(const char *prim, u32 code, const char *msg) { return term_new_ctr(NAM_ERR, 1, &txt); } +fn Term process_new_ok(Term val) { + return term_new_ctr(NAM_OK, 1, &val); +} + fn Term process_new_proc(u32 id, u32 seq) { Term args[2] = {term_new_num(id), term_new_num(seq)}; return term_new_ctr(PROCESS_NAM_PROC, 2, args); diff --git a/clang/prim/fn/process/kill.c b/clang/prim/fn/process/kill.c index 50c3f5a6..d470f89f 100644 --- a/clang/prim/fn/process/kill.c +++ b/clang/prim/fn/process/kill.c @@ -55,7 +55,7 @@ fn Term process_kill_go_proc(Term *args) { // %process_kill_go_io(proc) // ------------------------- -// #Pend{#Proc{id,seq+1}} | #Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}} | #ERR{String} +// #OK{#Pend{#Proc{id,seq+1}}|#Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}}} | #ERR{String} fn Term prim_fn_process_kill_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -76,7 +76,7 @@ fn Term prim_fn_process_kill_go_io(Term *args) { } if (finished) { - return process_new_rdy(id, seq + 1, signaled, code); + return process_new_ok(process_new_rdy(id, seq + 1, signaled, code)); } if (kill(pid, SIGTERM) < 0 && errno != ESRCH) { @@ -97,12 +97,12 @@ fn Term prim_fn_process_kill_go_io(Term *args) { } if (got == 0) { - return process_new_pend(id, seq + 1); + return process_new_ok(process_new_pend(id, seq + 1)); } process_status_from_wait(status, &signaled, &code); process_set_finished(id, signaled, code); - return process_new_rdy(id, seq + 1, signaled, code); + return process_new_ok(process_new_rdy(id, seq + 1, signaled, code)); } fn void prim_process_kill_init(void) { diff --git a/clang/prim/fn/process/poll.c b/clang/prim/fn/process/poll.c index ab6f847b..03e70a35 100644 --- a/clang/prim/fn/process/poll.c +++ b/clang/prim/fn/process/poll.c @@ -55,7 +55,7 @@ fn Term process_poll_go_proc(Term *args) { // %process_poll_go_io(proc) // ------------------------- -// #Pend{#Proc{id,seq+1}} | #Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}} | #ERR{String} +// #OK{#Pend{#Proc{id,seq+1}}|#Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}}} | #ERR{String} fn Term prim_fn_process_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -76,7 +76,7 @@ fn Term prim_fn_process_poll_go_io(Term *args) { } if (finished) { - return process_new_rdy(id, seq + 1, signaled, code); + return process_new_ok(process_new_rdy(id, seq + 1, signaled, code)); } int status = 0; @@ -93,12 +93,12 @@ fn Term prim_fn_process_poll_go_io(Term *args) { } if (got == 0) { - return process_new_pend(id, seq + 1); + return process_new_ok(process_new_pend(id, seq + 1)); } process_status_from_wait(status, &signaled, &code); process_set_finished(id, signaled, code); - return process_new_rdy(id, seq + 1, signaled, code); + return process_new_ok(process_new_rdy(id, seq + 1, signaled, code)); } fn void prim_process_poll_init(void) { diff --git a/clang/prim/fn/process/spawn.c b/clang/prim/fn/process/spawn.c index 6f5bdea6..5cf4b1d0 100644 --- a/clang/prim/fn/process/spawn.c +++ b/clang/prim/fn/process/spawn.c @@ -55,7 +55,7 @@ fn Term process_spawn_go_cmd(Term *args) { // %process_spawn_go_io(cmd) // ------------------------- -// #Proc{id,0} | #ERR{String} +// #OK{#Proc{id,0}} | #ERR{String} fn Term prim_fn_process_spawn_go_io(Term *args) { int MAX_CMD = 4096; char cmd[MAX_CMD]; @@ -93,7 +93,7 @@ fn Term prim_fn_process_spawn_go_io(Term *args) { PROCESS_SLOTS[id].code = 0; pthread_mutex_unlock(&PROCESS_LOCK); - return process_new_proc(id, 0); + return process_new_ok(process_new_proc(id, 0)); } fn void prim_process_spawn_init(void) { diff --git a/clang/prim/fn/process/wait.c b/clang/prim/fn/process/wait.c index fe3ba43b..909c8e8b 100644 --- a/clang/prim/fn/process/wait.c +++ b/clang/prim/fn/process/wait.c @@ -55,7 +55,7 @@ fn Term process_wait_go_proc(Term *args) { // %process_wait_go_io(proc) // ------------------------- -// #Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}} | #ERR{String} +// #OK{#Rdy{#Proc{id,seq+1},#Exit{n}|#Sig{n}}} | #ERR{String} fn Term prim_fn_process_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -76,7 +76,7 @@ fn Term prim_fn_process_wait_go_io(Term *args) { } if (finished) { - return process_new_rdy(id, seq + 1, signaled, code); + return process_new_ok(process_new_rdy(id, seq + 1, signaled, code)); } int status = 0; @@ -94,7 +94,7 @@ fn Term prim_fn_process_wait_go_io(Term *args) { process_status_from_wait(status, &signaled, &code); process_set_finished(id, signaled, code); - return process_new_rdy(id, seq + 1, signaled, code); + return process_new_ok(process_new_rdy(id, seq + 1, signaled, code)); } fn void prim_process_wait_init(void) { diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c index d03c823a..d414b1b2 100644 --- a/clang/prim/fn/stream/_.c +++ b/clang/prim/fn/stream/_.c @@ -35,6 +35,10 @@ fn Term stream_new_err(const char *prim, u32 code, const char *msg) { return term_new_ctr(NAM_ERR, 1, &txt); } +fn Term stream_new_ok(Term val) { + return term_new_ctr(NAM_OK, 1, &val); +} + fn Term stream_new_handle(u32 id, u32 seq) { Term args[2] = {term_new_num(id), term_new_num(seq)}; return term_new_ctr(STREAM_NAM_STRM, 2, args); diff --git a/clang/prim/fn/stream/poll.c b/clang/prim/fn/stream/poll.c index bff9d8e0..a9baa71d 100644 --- a/clang/prim/fn/stream/poll.c +++ b/clang/prim/fn/stream/poll.c @@ -55,7 +55,7 @@ fn Term stream_poll_go_strm(Term *args) { // %stream_poll_go_io(strm) // ------------------------ -// #Pend{#Strm{id,seq+1}} | #Rdy{#Strm{id,seq+1},#Byt{n}|#Eof} | #ERR{String} +// #OK{#Pend{#Strm{id,seq+1}}|#Rdy{#Strm{id,seq+1},#Byt{n}|#Eof}} | #ERR{String} fn Term prim_fn_stream_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -89,12 +89,12 @@ fn Term prim_fn_stream_poll_go_io(Term *args) { return stream_new_err("stream_poll", STREAM_ERR_IO, strerror(errno)); } if (read_ret == 0) { - return stream_new_pend(id, seq + 1); + return stream_new_ok(stream_new_pend(id, seq + 1)); } if (eof) { - return stream_new_rdy_eof(id, seq + 1); + return stream_new_ok(stream_new_rdy_eof(id, seq + 1)); } - return stream_new_rdy_byt(id, seq + 1, byt); + return stream_new_ok(stream_new_rdy_byt(id, seq + 1, byt)); } fn void prim_stream_poll_init(void) { diff --git a/clang/prim/fn/stream/stdin_open.c b/clang/prim/fn/stream/stdin_open.c index ee8b40d7..d72b72e5 100644 --- a/clang/prim/fn/stream/stdin_open.c +++ b/clang/prim/fn/stream/stdin_open.c @@ -55,7 +55,7 @@ fn Term stream_stdin_open_go_seed(Term *args) { // %stream_stdin_open_go_io(seed) // ------------------------------- -// #Strm{id,0} | #ERR{String} +// #OK{#Strm{id,0}} | #ERR{String} fn Term prim_fn_stream_stdin_open_go_io(Term *args) { (void)args; @@ -74,7 +74,7 @@ fn Term prim_fn_stream_stdin_open_go_io(Term *args) { STREAM_SLOTS[id].fd = 0; pthread_mutex_unlock(&STREAM_LOCK); - return stream_new_handle(id, 0); + return stream_new_ok(stream_new_handle(id, 0)); } fn void prim_stream_stdin_open_init(void) { diff --git a/clang/prim/fn/stream/wait.c b/clang/prim/fn/stream/wait.c index 3cfbd97f..5bfbcddc 100644 --- a/clang/prim/fn/stream/wait.c +++ b/clang/prim/fn/stream/wait.c @@ -55,7 +55,7 @@ fn Term stream_wait_go_strm(Term *args) { // %stream_wait_go_io(strm) // ------------------------ -// #Rdy{#Strm{id,seq+1},#Byt{n}|#Eof} | #ERR{String} +// #OK{#Rdy{#Strm{id,seq+1},#Byt{n}|#Eof}} | #ERR{String} fn Term prim_fn_stream_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -93,9 +93,9 @@ fn Term prim_fn_stream_wait_go_io(Term *args) { continue; } if (eof) { - return stream_new_rdy_eof(id, seq + 1); + return stream_new_ok(stream_new_rdy_eof(id, seq + 1)); } - return stream_new_rdy_byt(id, seq + 1, byt); + return stream_new_ok(stream_new_rdy_byt(id, seq + 1, byt)); } } diff --git a/clang/prim/fn/timer/_.c b/clang/prim/fn/timer/_.c index 675d6e8f..3b918f60 100644 --- a/clang/prim/fn/timer/_.c +++ b/clang/prim/fn/timer/_.c @@ -44,6 +44,10 @@ fn Term timer_new_err(const char *prim, u32 code, const char *msg) { return term_new_ctr(NAM_ERR, 1, &txt); } +fn Term timer_new_ok(Term val) { + return term_new_ctr(NAM_OK, 1, &val); +} + fn Term timer_new_time(u32 id, u32 seq) { Term args[2] = {term_new_num(id), term_new_num(seq)}; return term_new_ctr(TIMER_NAM_TIME, 2, args); diff --git a/clang/prim/fn/timer/poll.c b/clang/prim/fn/timer/poll.c index 1ba6dd30..925ca021 100644 --- a/clang/prim/fn/timer/poll.c +++ b/clang/prim/fn/timer/poll.c @@ -55,7 +55,7 @@ fn Term timer_poll_go_time(Term *args) { // %timer_poll_go_io(time) // ----------------------- -// #Pend{#Time{id,seq+1}} | #Rdy{#Time{id,seq+1}} | #ERR{String} +// #OK{#Pend{#Time{id,seq+1}}|#Rdy{#Time{id,seq+1}}} | #ERR{String} fn Term prim_fn_timer_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -74,9 +74,9 @@ fn Term prim_fn_timer_poll_go_io(Term *args) { u64 now = timer_now_ns(); if (now >= due_ns) { - return timer_new_rdy(id, seq + 1); + return timer_new_ok(timer_new_rdy(id, seq + 1)); } - return timer_new_pend(id, seq + 1); + return timer_new_ok(timer_new_pend(id, seq + 1)); } fn void prim_timer_poll_init(void) { diff --git a/clang/prim/fn/timer/start.c b/clang/prim/fn/timer/start.c index d9166e91..16ff7e34 100644 --- a/clang/prim/fn/timer/start.c +++ b/clang/prim/fn/timer/start.c @@ -55,7 +55,7 @@ fn Term timer_start_go_ms(Term *args) { // %timer_start_go_io(ms) // ---------------------- -// #Time{id,0} | #ERR{String} +// #OK{#Time{id,0}} | #ERR{String} fn Term prim_fn_timer_start_go_io(Term *args) { u32 ms = 0; if (!timer_parse_num(args[0], &ms)) { @@ -81,7 +81,7 @@ fn Term prim_fn_timer_start_go_io(Term *args) { TIMER_SLOTS[id].due_ns = due; pthread_mutex_unlock(&TIMER_LOCK); - return timer_new_time(id, 0); + return timer_new_ok(timer_new_time(id, 0)); } fn void prim_timer_start_init(void) { diff --git a/clang/prim/fn/timer/wait.c b/clang/prim/fn/timer/wait.c index 60fb796a..01361fe5 100644 --- a/clang/prim/fn/timer/wait.c +++ b/clang/prim/fn/timer/wait.c @@ -55,7 +55,7 @@ fn Term timer_wait_go_time(Term *args) { // %timer_wait_go_io(time) // ----------------------- -// #Rdy{#Time{id,seq+1}} | #ERR{String} +// #OK{#Rdy{#Time{id,seq+1}}} | #ERR{String} fn Term prim_fn_timer_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; @@ -77,7 +77,7 @@ fn Term prim_fn_timer_wait_go_io(Term *args) { timer_sleep_ns(due_ns - now); } - return timer_new_rdy(id, seq + 1); + return timer_new_ok(timer_new_rdy(id, seq + 1)); } fn void prim_timer_wait_init(void) { From 8c038da71a5e34bd8b9af894c95d867e59fc7d37 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 10:32:37 -0300 Subject: [PATCH 18/35] updating tests --- test/prim_process_bind.hvm4 | 9 +++++++++ test/prim_process_kill_done.hvm4 | 14 ++++---------- test/prim_process_poll_pending.hvm4 | 6 ++++-- test/prim_process_spawn.hvm4 | 2 +- test/prim_process_stale.hvm4 | 6 +++--- test/prim_process_sup.hvm4 | 7 +++++-- test/prim_process_wait_exit.hvm4 | 6 ++++-- test/prim_stream_poll_open.hvm4 | 4 +++- test/prim_stream_poll_stale.hvm4 | 6 +++--- test/prim_stream_stdin_open.hvm4 | 2 +- test/prim_stream_stdin_open_inc.hvm4 | 2 +- test/prim_stream_stdin_open_sup.hvm4 | 2 +- test/prim_timer_bind.hvm4 | 9 +++++++++ test/prim_timer_inc.hvm4 | 6 ++++-- test/prim_timer_poll_pending.hvm4 | 6 ++++-- test/prim_timer_stale.hvm4 | 6 +++--- test/prim_timer_start.hvm4 | 2 +- test/prim_timer_sup.hvm4 | 7 +++++-- test/prim_timer_wait_zero.hvm4 | 6 ++++-- 19 files changed, 69 insertions(+), 39 deletions(-) create mode 100644 test/prim_process_bind.hvm4 create mode 100644 test/prim_timer_bind.hvm4 diff --git a/test/prim_process_bind.hvm4 b/test/prim_process_bind.hvm4 new file mode 100644 index 00000000..15ef34d9 --- /dev/null +++ b/test/prim_process_bind.hvm4 @@ -0,0 +1,9 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +@main = @bind(%process_spawn("exit 7"), λp.%process_wait(p)) +//!#OK{#Rdy{#Proc{1,1},#Exit{7}}} diff --git a/test/prim_process_kill_done.hvm4 b/test/prim_process_kill_done.hvm4 index 22ffd7d1..136f54b5 100644 --- a/test/prim_process_kill_done.hvm4 +++ b/test/prim_process_kill_done.hvm4 @@ -1,11 +1,5 @@ -@get_proc = λ{ - #Rdy: λp.λs.p - #Pend: λp.p - &{} -} - @main = - !!r = %process_wait(%process_spawn("exit 0")); - !!p = @get_proc(r); - %process_kill(p) -//!#Rdy{#Proc{1,2},#Exit{0}} + !!s = %process_spawn("exit 0"); + !!r = %process_wait(#Proc{1,0}); + %process_kill(#Proc{1,1}) +//!#OK{#Rdy{#Proc{1,2},#Exit{0}}} diff --git a/test/prim_process_poll_pending.hvm4 b/test/prim_process_poll_pending.hvm4 index 788476cb..f4593cb0 100644 --- a/test/prim_process_poll_pending.hvm4 +++ b/test/prim_process_poll_pending.hvm4 @@ -1,2 +1,4 @@ -@main = %process_poll(%process_spawn("sleep 1")) -//!#Pend{#Proc{1,1}} +@main = + !!x = %process_spawn("sleep 1"); + %process_poll(#Proc{1,0}) +//!#OK{#Pend{#Proc{1,1}}} diff --git a/test/prim_process_spawn.hvm4 b/test/prim_process_spawn.hvm4 index 7b4e4cf8..80f58ee2 100644 --- a/test/prim_process_spawn.hvm4 +++ b/test/prim_process_spawn.hvm4 @@ -1,2 +1,2 @@ @main = %process_spawn("exit 0") -//!#Proc{1,0} +//!#OK{#Proc{1,0}} diff --git a/test/prim_process_stale.hvm4 b/test/prim_process_stale.hvm4 index 77762100..cf7b517e 100644 --- a/test/prim_process_stale.hvm4 +++ b/test/prim_process_stale.hvm4 @@ -1,5 +1,5 @@ @main = - !!&p = %process_spawn("exit 0"); - !!x = %process_poll(p); - %process_poll(p) + !!x = %process_spawn("sleep 1"); + !!y = %process_poll(#Proc{1,0}); + %process_poll(#Proc{1,0}) //EXPECT_CONTAINS:E3 stale process handle diff --git a/test/prim_process_sup.hvm4 b/test/prim_process_sup.hvm4 index 56673552..d87fba5a 100644 --- a/test/prim_process_sup.hvm4 +++ b/test/prim_process_sup.hvm4 @@ -1,2 +1,5 @@ -@main = %process_wait(&L{%process_spawn("exit 0"), %process_spawn("exit 0")}) -//!&L{#Rdy{#Proc{1,1},#Exit{0}},#Rdy{#Proc{2,1},#Exit{0}}} +@main = + !!a = %process_spawn("exit 0"); + !!b = %process_spawn("exit 0"); + %process_wait(&L{#Proc{1,0}, #Proc{2,0}}) +//!&L{#OK{#Rdy{#Proc{1,1},#Exit{0}}},#OK{#Rdy{#Proc{2,1},#Exit{0}}}} diff --git a/test/prim_process_wait_exit.hvm4 b/test/prim_process_wait_exit.hvm4 index f10184b2..06bf8fad 100644 --- a/test/prim_process_wait_exit.hvm4 +++ b/test/prim_process_wait_exit.hvm4 @@ -1,2 +1,4 @@ -@main = %process_wait(%process_spawn("exit 7")) -//!#Rdy{#Proc{1,1},#Exit{7}} +@main = + !!x = %process_spawn("exit 7"); + %process_wait(#Proc{1,0}) +//!#OK{#Rdy{#Proc{1,1},#Exit{7}}} diff --git a/test/prim_stream_poll_open.hvm4 b/test/prim_stream_poll_open.hvm4 index 97a5e22b..dd9a6495 100644 --- a/test/prim_stream_poll_open.hvm4 +++ b/test/prim_stream_poll_open.hvm4 @@ -1,2 +1,4 @@ -@main = %stream_poll(%stream_stdin_open(0)) +@main = + !!x = %stream_stdin_open(0); + %stream_poll(#Strm{1,0}) //EXPECT_CONTAINS:#Strm{1,1} diff --git a/test/prim_stream_poll_stale.hvm4 b/test/prim_stream_poll_stale.hvm4 index d64251bb..91d4d546 100644 --- a/test/prim_stream_poll_stale.hvm4 +++ b/test/prim_stream_poll_stale.hvm4 @@ -1,5 +1,5 @@ @main = - !!&s = %stream_stdin_open(0); - !!x = %stream_poll(s); - %stream_poll(s) + !!x = %stream_stdin_open(0); + !!y = %stream_poll(#Strm{1,0}); + %stream_poll(#Strm{1,0}) //EXPECT_CONTAINS:E3 stale stream handle diff --git a/test/prim_stream_stdin_open.hvm4 b/test/prim_stream_stdin_open.hvm4 index 1ccece48..6f294c36 100644 --- a/test/prim_stream_stdin_open.hvm4 +++ b/test/prim_stream_stdin_open.hvm4 @@ -1,2 +1,2 @@ @main = %stream_stdin_open(0) -//!#Strm{1,0} +//!#OK{#Strm{1,0}} diff --git a/test/prim_stream_stdin_open_inc.hvm4 b/test/prim_stream_stdin_open_inc.hvm4 index d37ece39..00f95c6a 100644 --- a/test/prim_stream_stdin_open_inc.hvm4 +++ b/test/prim_stream_stdin_open_inc.hvm4 @@ -1,2 +1,2 @@ @main = %stream_stdin_open(↑0) -//!↑#Strm{1,0} +//!↑#OK{#Strm{1,0}} diff --git a/test/prim_stream_stdin_open_sup.hvm4 b/test/prim_stream_stdin_open_sup.hvm4 index cc0fd8bd..d314b28f 100644 --- a/test/prim_stream_stdin_open_sup.hvm4 +++ b/test/prim_stream_stdin_open_sup.hvm4 @@ -1,2 +1,2 @@ @main = %stream_stdin_open(&L{0,0}) -//!&L{#Strm{1,0},#Strm{2,0}} +//!&L{#OK{#Strm{1,0}},#OK{#Strm{2,0}}} diff --git a/test/prim_timer_bind.hvm4 b/test/prim_timer_bind.hvm4 new file mode 100644 index 00000000..a83357ac --- /dev/null +++ b/test/prim_timer_bind.hvm4 @@ -0,0 +1,9 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +@main = @bind(%timer_start(0), λh.%timer_wait(h)) +//!#OK{#Rdy{#Time{1,1}}} diff --git a/test/prim_timer_inc.hvm4 b/test/prim_timer_inc.hvm4 index d6567ae8..16257e42 100644 --- a/test/prim_timer_inc.hvm4 +++ b/test/prim_timer_inc.hvm4 @@ -1,2 +1,4 @@ -@main = %timer_wait(↑%timer_start(0)) -//!↑#Rdy{#Time{1,1}} +@main = + !!x = %timer_start(0); + %timer_wait(↑#Time{1,0}) +//!↑#OK{#Rdy{#Time{1,1}}} diff --git a/test/prim_timer_poll_pending.hvm4 b/test/prim_timer_poll_pending.hvm4 index e08ca62c..40b2a87b 100644 --- a/test/prim_timer_poll_pending.hvm4 +++ b/test/prim_timer_poll_pending.hvm4 @@ -1,2 +1,4 @@ -@main = %timer_poll(%timer_start(1000)) -//!#Pend{#Time{1,1}} +@main = + !!x = %timer_start(1000); + %timer_poll(#Time{1,0}) +//!#OK{#Pend{#Time{1,1}}} diff --git a/test/prim_timer_stale.hvm4 b/test/prim_timer_stale.hvm4 index b8ba06b8..b42b639a 100644 --- a/test/prim_timer_stale.hvm4 +++ b/test/prim_timer_stale.hvm4 @@ -1,5 +1,5 @@ @main = - !!&h = %timer_start(0); - !!x = %timer_poll(h); - %timer_poll(h) + !!x = %timer_start(0); + !!y = %timer_poll(#Time{1,0}); + %timer_poll(#Time{1,0}) //EXPECT_CONTAINS:E3 stale timer handle diff --git a/test/prim_timer_start.hvm4 b/test/prim_timer_start.hvm4 index 74d98a38..06bdbaaf 100644 --- a/test/prim_timer_start.hvm4 +++ b/test/prim_timer_start.hvm4 @@ -1,2 +1,2 @@ @main = %timer_start(0) -//!#Time{1,0} +//!#OK{#Time{1,0}} diff --git a/test/prim_timer_sup.hvm4 b/test/prim_timer_sup.hvm4 index 23557e12..aedb7f04 100644 --- a/test/prim_timer_sup.hvm4 +++ b/test/prim_timer_sup.hvm4 @@ -1,2 +1,5 @@ -@main = %timer_wait(&L{%timer_start(0), %timer_start(0)}) -//!&L{#Rdy{#Time{1,1}},#Rdy{#Time{2,1}}} +@main = + !!a = %timer_start(0); + !!b = %timer_start(0); + %timer_wait(&L{#Time{1,0}, #Time{2,0}}) +//!&L{#OK{#Rdy{#Time{1,1}}},#OK{#Rdy{#Time{2,1}}}} diff --git a/test/prim_timer_wait_zero.hvm4 b/test/prim_timer_wait_zero.hvm4 index 7cda3872..f7de372f 100644 --- a/test/prim_timer_wait_zero.hvm4 +++ b/test/prim_timer_wait_zero.hvm4 @@ -1,2 +1,4 @@ -@main = %timer_wait(%timer_start(0)) -//!#Rdy{#Time{1,1}} +@main = + !!x = %timer_start(0); + %timer_wait(#Time{1,0}) +//!#OK{#Rdy{#Time{1,1}}} From d3ed29ab9b72296620c5fe6eff3fa5b2b6224eea Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Tue, 10 Feb 2026 17:56:02 +0400 Subject: [PATCH 19/35] prims: uid/uuid --- clang/hvm.c | 2 + clang/prim/fn/uid.c | 44 ++++++++++++++++++++++ clang/prim/fn/uuid.c | 90 ++++++++++++++++++++++++++++++++++++++++++++ clang/prim/init.c | 2 + 4 files changed, 138 insertions(+) create mode 100644 clang/prim/fn/uid.c create mode 100644 clang/prim/fn/uuid.c diff --git a/clang/hvm.c b/clang/hvm.c index cd2e89d6..8b0fae93 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -367,6 +367,8 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/panic.c" #include "prim/fn/env.c" #include "prim/fn/rand.c" +#include "prim/fn/uuid.c" +#include "prim/fn/uid.c" #include "prim/fn/process/_.c" #include "prim/fn/stream/_.c" #include "prim/fn/read_bytes.c" diff --git a/clang/prim/fn/uid.c b/clang/prim/fn/uid.c new file mode 100644 index 00000000..79c0417e --- /dev/null +++ b/clang/prim/fn/uid.c @@ -0,0 +1,44 @@ +#include + +static _Atomic u64 UID_PREFIX = 0; +static _Atomic u64 UID_COUNT = 0; + +fn u64 uid_get_prefix(void) { + u64 prefix = atomic_load_explicit(&UID_PREFIX, memory_order_relaxed); + if (prefix != 0) { + return prefix; + } + + struct timespec ts; + clock_gettime(CLOCK_REALTIME, &ts); + u64 seed = ((u64)ts.tv_sec << 32) ^ (u64)ts.tv_nsec ^ (u64)getpid(); + if (seed == 0) { + seed = 1; + } + + u64 expected = 0; + if (atomic_compare_exchange_strong_explicit( + &UID_PREFIX, &expected, seed, memory_order_relaxed, memory_order_relaxed)) { + return seed; + } + + return atomic_load_explicit(&UID_PREFIX, memory_order_relaxed); +} + +// %uid(dummy) +// ----------- +// String (guaranteed unique per process) +fn Term prim_fn_uid(Term *args) { + (void)args[0]; + + u64 prefix = uid_get_prefix(); + u64 n = atomic_fetch_add_explicit(&UID_COUNT, 1, memory_order_relaxed); + + return term_string_printf("uid-%016llx-%016llx", + (unsigned long long)prefix, + (unsigned long long)n); +} + +fn void prim_uid_init(void) { + prim_register("uid", 3, 1, prim_fn_uid); +} diff --git a/clang/prim/fn/uuid.c b/clang/prim/fn/uuid.c new file mode 100644 index 00000000..9090360e --- /dev/null +++ b/clang/prim/fn/uuid.c @@ -0,0 +1,90 @@ +#include +#include + +fn int uuid_fill_random(u8 out[16], int *err_out) { + int fd = open("/dev/urandom", O_RDONLY); + if (fd < 0) { + if (err_out != NULL) { + *err_out = errno; + } + return 0; + } + + int got = 0; + while (got < 16) { + ssize_t n = read(fd, out + got, (size_t)(16 - got)); + if (n < 0) { + if (errno == EINTR) { + continue; + } + int err = errno; + close(fd); + if (err_out != NULL) { + *err_out = err; + } + return 0; + } + if (n == 0) { + close(fd); + if (err_out != NULL) { + *err_out = EIO; + } + return 0; + } + got += (int)n; + } + + if (close(fd) != 0) { + if (err_out != NULL) { + *err_out = errno; + } + return 0; + } + + if (err_out != NULL) { + *err_out = 0; + } + return 1; +} + +fn void uuid_v4_format(const u8 b[16], char out[37]) { + static const char *HEX = "0123456789abcdef"; + int j = 0; + + for (int i = 0; i < 16; ++i) { + if (i == 4 || i == 6 || i == 8 || i == 10) { + out[j++] = '-'; + } + out[j++] = HEX[(b[i] >> 4) & 0xF]; + out[j++] = HEX[b[i] & 0xF]; + } + + out[j] = 0; +} + +// %uuid(dummy) +// ------------ +// #OK{String} | #ERR{String} +fn Term prim_fn_uuid(Term *args) { + (void)args[0]; + + const char *RNG_ERR_FMT = "ERROR(uuid): failed to get secure random bytes: %s (errno=%d)"; + u8 bytes[16]; + int err = 0; + if (!uuid_fill_random(bytes, &err)) { + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(RNG_ERR_FMT, strerror(err), err) }); + } + + // RFC4122 variant + version 4 layout bits. + bytes[6] = (u8)((bytes[6] & 0x0F) | 0x40); + bytes[8] = (u8)((bytes[8] & 0x3F) | 0x80); + + char str[37]; + uuid_v4_format(bytes, str); + Term out = term_string_from_utf8(str); + return term_new_ctr(NAM_OK, 1, &out); +} + +fn void prim_uuid_init(void) { + prim_register("uuid", 4, 1, prim_fn_uuid); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 362a4cda..bec89cbe 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -2,6 +2,8 @@ fn void prim_init(void) { prim_log_init(); prim_panic_init(); prim_rand_init(); + prim_uuid_init(); + prim_uid_init(); prim_process_init(); prim_stream_init(); prim_timer_init(); From ce5e76a3cfabb3a6aafc862ea219fe268c75291a Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 11:53:03 -0300 Subject: [PATCH 20/35] stream file --- clang/prim/fn/stream/_.c | 6 ++ clang/prim/fn/stream/close.c | 100 ++++++++++++++++++++++++ clang/prim/fn/stream/file_open.c | 96 +++++++++++++++++++++++ clang/prim/fn/stream/poll.c | 25 +++++- clang/prim/fn/stream/wait.c | 19 ++++- docs/hvm/core.md | 8 ++ docs/hvm/syntax.md | 12 +++ test/prim_stream_close_bad_handle.hvm4 | 2 + test/prim_stream_close_era.hvm4 | 2 + test/prim_stream_close_ok.hvm4 | 4 + test/prim_stream_close_stale.hvm4 | 5 ++ test/prim_stream_file_open.hvm4 | 2 + test/prim_stream_file_open_era.hvm4 | 2 + test/prim_stream_file_open_inc.hvm4 | 2 + test/prim_stream_file_open_missing.hvm4 | 2 + test/prim_stream_file_open_sup.hvm4 | 2 + test/prim_stream_poll_closed.hvm4 | 5 ++ test/prim_stream_poll_file_eof.hvm4 | 4 + test/prim_stream_wait_file_eof.hvm4 | 4 + 19 files changed, 297 insertions(+), 5 deletions(-) create mode 100644 clang/prim/fn/stream/close.c create mode 100644 clang/prim/fn/stream/file_open.c create mode 100644 test/prim_stream_close_bad_handle.hvm4 create mode 100644 test/prim_stream_close_era.hvm4 create mode 100644 test/prim_stream_close_ok.hvm4 create mode 100644 test/prim_stream_close_stale.hvm4 create mode 100644 test/prim_stream_file_open.hvm4 create mode 100644 test/prim_stream_file_open_era.hvm4 create mode 100644 test/prim_stream_file_open_inc.hvm4 create mode 100644 test/prim_stream_file_open_missing.hvm4 create mode 100644 test/prim_stream_file_open_sup.hvm4 create mode 100644 test/prim_stream_poll_closed.hvm4 create mode 100644 test/prim_stream_poll_file_eof.hvm4 create mode 100644 test/prim_stream_wait_file_eof.hvm4 diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c index d414b1b2..c7d1cef2 100644 --- a/clang/prim/fn/stream/_.c +++ b/clang/prim/fn/stream/_.c @@ -1,5 +1,6 @@ #include #include +#include #define STREAM_CAP (1u << 20) @@ -10,6 +11,7 @@ #define STREAM_ERR_IO 5 #define STREAM_KIND_STDIN 1 +#define STREAM_KIND_FILE 2 typedef struct { u32 expected_seq; @@ -214,8 +216,10 @@ fn int stream_stdin_read(int fd, int timeout_ms, u8 *out_byt, u8 *out_eof) { } #include "stdin_open.c" +#include "file_open.c" #include "poll.c" #include "wait.c" +#include "close.c" fn void prim_stream_init(void) { STREAM_NAM_STRM = nick_from_str("Strm", 4); @@ -225,6 +229,8 @@ fn void prim_stream_init(void) { STREAM_NAM_EOF = nick_from_str("Eof", 3); prim_stream_stdin_open_init(); + prim_stream_file_open_init(); prim_stream_poll_init(); prim_stream_wait_init(); + prim_stream_close_init(); } diff --git a/clang/prim/fn/stream/close.c b/clang/prim/fn/stream/close.c new file mode 100644 index 00000000..2de45aca --- /dev/null +++ b/clang/prim/fn/stream/close.c @@ -0,0 +1,100 @@ +// %stream_close(strm) +// ------------------- +// %stream_close_go_strm(strm) +fn Term prim_fn_stream_close(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("stream_close_go_strm", 20), 1, args0); + return wnf(t); +} + +// %stream_close_go_strm(strm) +// --------------------------- +// Lift `strm` over ERA/INC/SUP; default forwards to io stage. +fn Term stream_close_go_strm(Term *args) { + Term strm_wnf = wnf(args[0]); + + switch (term_tag(strm_wnf)) { + case ERA: { + // %stream_close_go_strm(&{}) + // -------------------------- stream-close-go-strm-era + // &{} + return term_new_era(); + } + case INC: { + // %stream_close_go_strm(↑x) + // ------------------------- stream-close-go-strm-inc + // ↑(%stream_close(x)) + u32 inc_loc = term_val(strm_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("stream_close", 12), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %stream_close_go_strm(&L{x,y}) + // ------------------------------- stream-close-go-strm-sup + // &L{%stream_close(x), %stream_close(y)} + u32 lab = term_ext(strm_wnf); + u32 sup_loc = term_val(strm_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("stream_close", 12), 1, &x); + Term t1 = term_new_pri(table_find("stream_close", 12), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %stream_close_go_strm(strm) + // --------------------------- stream-close-go-strm-default + // %stream_close_go_io(strm) + Term args0[1] = {strm_wnf}; + Term t = term_new_pri(table_find("stream_close_go_io", 18), 1, args0); + return wnf(t); + } + } +} + +// %stream_close_go_io(strm) +// ------------------------- +// #OK{#Nil} | #ERR{String} +fn Term prim_fn_stream_close_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!stream_parse_handle(args[0], &id, &seq)) { + return stream_new_err("stream_close", STREAM_ERR_BAD_HANDLE, "invalid `strm`; expected #Strm{id,seq}"); + } + + if (!stream_is_valid_id(id)) { + return stream_new_err("stream_close", STREAM_ERR_BAD_HANDLE, "unknown stream id"); + } + + u8 kind = 0; + u8 closed = 0; + int fd = -1; + if (!stream_claim(id, seq, &kind, &closed, &fd)) { + return stream_new_err("stream_close", STREAM_ERR_STALE, "stale stream handle"); + } + + if (closed) { + return stream_new_err("stream_close", STREAM_ERR_BAD_HANDLE, "stream is closed"); + } + + if (kind == STREAM_KIND_FILE) { + while (close(fd) < 0) { + if (errno == EINTR) { + continue; + } + stream_set_closed(id); + return stream_new_err("stream_close", STREAM_ERR_IO, strerror(errno)); + } + } + + stream_set_closed(id); + Term nil = term_new_ctr(NAM_NIL, 0, NULL); + return stream_new_ok(nil); +} + +fn void prim_stream_close_init(void) { + prim_register("stream_close", 12, 1, prim_fn_stream_close); + prim_register("stream_close_go_strm", 20, 1, stream_close_go_strm); + prim_register("stream_close_go_io", 18, 1, prim_fn_stream_close_go_io); +} diff --git a/clang/prim/fn/stream/file_open.c b/clang/prim/fn/stream/file_open.c new file mode 100644 index 00000000..3d913aec --- /dev/null +++ b/clang/prim/fn/stream/file_open.c @@ -0,0 +1,96 @@ +// %stream_file_open(path) +// ----------------------- +// %stream_file_open_go_path(path) +fn Term prim_fn_stream_file_open(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("stream_file_open_go_path", 24), 1, args0); + return wnf(t); +} + +// %stream_file_open_go_path(path) +// ------------------------------- +// Lift `path` over ERA/INC/SUP; default forwards to io stage. +fn Term stream_file_open_go_path(Term *args) { + Term path_wnf = wnf(args[0]); + + switch (term_tag(path_wnf)) { + case ERA: { + // %stream_file_open_go_path(&{}) + // ------------------------------ stream-file-open-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %stream_file_open_go_path(↑x) + // ----------------------------- stream-file-open-go-path-inc + // ↑(%stream_file_open(x)) + u32 inc_loc = term_val(path_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("stream_file_open", 16), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %stream_file_open_go_path(&L{x,y}) + // ----------------------------------- stream-file-open-go-path-sup + // &L{%stream_file_open(x), %stream_file_open(y)} + u32 lab = term_ext(path_wnf); + u32 sup_loc = term_val(path_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("stream_file_open", 16), 1, &x); + Term t1 = term_new_pri(table_find("stream_file_open", 16), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %stream_file_open_go_path(path) + // ------------------------------- stream-file-open-go-path-default + // %stream_file_open_go_io(path) + Term args0[1] = {path_wnf}; + Term t = term_new_pri(table_find("stream_file_open_go_io", 22), 1, args0); + return wnf(t); + } + } +} + +// %stream_file_open_go_io(path) +// ----------------------------- +// #OK{#Strm{id,0}} | #ERR{String} +fn Term prim_fn_stream_file_open_go_io(Term *args) { + int MAX_PATH = 4096; + char path[MAX_PATH]; + + HStrErr path_err; + if (!term_string_to_utf8_cstr(args[0], path, MAX_PATH, NULL, &path_err)) { + return term_string_from_hstrerr("stream_file_open", "path", MAX_PATH, path_err); + } + + int fd = open(path, O_RDONLY | O_CLOEXEC); + if (fd < 0) { + return stream_new_err("stream_file_open", STREAM_ERR_IO, strerror(errno)); + } + + pthread_mutex_lock(&STREAM_LOCK); + + u32 id = STREAM_NEXT_ID; + if (id >= STREAM_CAP) { + pthread_mutex_unlock(&STREAM_LOCK); + close(fd); + return stream_new_err("stream_file_open", STREAM_ERR_FULL, "stream table is full"); + } + + STREAM_NEXT_ID = id + 1; + STREAM_SLOTS[id].expected_seq = 0; + STREAM_SLOTS[id].kind = STREAM_KIND_FILE; + STREAM_SLOTS[id].closed = 0; + STREAM_SLOTS[id].fd = fd; + + pthread_mutex_unlock(&STREAM_LOCK); + return stream_new_ok(stream_new_handle(id, 0)); +} + +fn void prim_stream_file_open_init(void) { + prim_register("stream_file_open", 16, 1, prim_fn_stream_file_open); + prim_register("stream_file_open_go_path", 24, 1, stream_file_open_go_path); + prim_register("stream_file_open_go_io", 22, 1, prim_fn_stream_file_open_go_io); +} diff --git a/clang/prim/fn/stream/poll.c b/clang/prim/fn/stream/poll.c index a9baa71d..9a86b60c 100644 --- a/clang/prim/fn/stream/poll.c +++ b/clang/prim/fn/stream/poll.c @@ -78,22 +78,39 @@ fn Term prim_fn_stream_poll_go_io(Term *args) { return stream_new_err("stream_poll", STREAM_ERR_BAD_HANDLE, "stream is closed"); } - if (kind != STREAM_KIND_STDIN) { + if (kind != STREAM_KIND_STDIN && kind != STREAM_KIND_FILE) { return stream_new_err("stream_poll", STREAM_ERR_BAD_HANDLE, "unsupported stream kind"); } + if (kind == STREAM_KIND_FILE) { + while (1) { + u8 byt = 0; + ssize_t rd = read(fd, &byt, 1); + if (rd == 1) { + return stream_new_ok(stream_new_rdy_byt(id, seq + 1, byt)); + } + if (rd == 0) { + return stream_new_ok(stream_new_rdy_eof(id, seq + 1)); + } + if (errno == EINTR) { + continue; + } + return stream_new_err("stream_poll", STREAM_ERR_IO, strerror(errno)); + } + } + u8 byt = 0; u8 eof = 0; int read_ret = stream_stdin_read(fd, 0, &byt, &eof); if (read_ret < 0) { return stream_new_err("stream_poll", STREAM_ERR_IO, strerror(errno)); } - if (read_ret == 0) { - return stream_new_ok(stream_new_pend(id, seq + 1)); - } if (eof) { return stream_new_ok(stream_new_rdy_eof(id, seq + 1)); } + if (read_ret == 0) { + return stream_new_ok(stream_new_pend(id, seq + 1)); + } return stream_new_ok(stream_new_rdy_byt(id, seq + 1, byt)); } diff --git a/clang/prim/fn/stream/wait.c b/clang/prim/fn/stream/wait.c index 5bfbcddc..985a944d 100644 --- a/clang/prim/fn/stream/wait.c +++ b/clang/prim/fn/stream/wait.c @@ -78,10 +78,27 @@ fn Term prim_fn_stream_wait_go_io(Term *args) { return stream_new_err("stream_wait", STREAM_ERR_BAD_HANDLE, "stream is closed"); } - if (kind != STREAM_KIND_STDIN) { + if (kind != STREAM_KIND_STDIN && kind != STREAM_KIND_FILE) { return stream_new_err("stream_wait", STREAM_ERR_BAD_HANDLE, "unsupported stream kind"); } + if (kind == STREAM_KIND_FILE) { + while (1) { + u8 byt = 0; + ssize_t rd = read(fd, &byt, 1); + if (rd == 1) { + return stream_new_ok(stream_new_rdy_byt(id, seq + 1, byt)); + } + if (rd == 0) { + return stream_new_ok(stream_new_rdy_eof(id, seq + 1)); + } + if (errno == EINTR) { + continue; + } + return stream_new_err("stream_wait", STREAM_ERR_IO, strerror(errno)); + } + } + while (1) { u8 byt = 0; u8 eof = 0; diff --git a/docs/hvm/core.md b/docs/hvm/core.md index ee877b19..ee89a46d 100644 --- a/docs/hvm/core.md +++ b/docs/hvm/core.md @@ -52,3 +52,11 @@ Oper ::= "+" | "-" | "*" | "/" | "%" | "&&" | "||" correct arity; `%log` prints a string and yields `#Nil`. - Surface sugar accepts `λ$x. body` as an unscoped lambda, equivalent to `! f = λ x ; f(body)` with fresh `f` (see `docs/hvm/syntax.md`). + correct arity; `%log` prints a string and yields `#Nil`; process primitives + (`%process_spawn`, `%process_poll`, `%process_wait`, `%process_kill`) use + `#Proc`, `#Pend`, `#Rdy`, `#Exit`, and `#Sig` under `#OK{...}`, or `#ERR{String}`; + timer primitives (`%timer_start`, `%timer_poll`, `%timer_wait`) use `#Time`, + `#Pend`, and `#Rdy` under `#OK{...}`, or `#ERR{String}`; stream primitives + (`%stream_stdin_open`, `%stream_file_open`, `%stream_poll`, `%stream_wait`, + `%stream_close`) use `#Strm`, `#Pend`, `#Rdy`, `#Byt`, and `#Eof` under + `#OK{...}`, or `#ERR{String}` (`%stream_close` returns `#OK{#Nil}`). diff --git a/docs/hvm/syntax.md b/docs/hvm/syntax.md index 7a31949f..0309705c 100644 --- a/docs/hvm/syntax.md +++ b/docs/hvm/syntax.md @@ -231,6 +231,18 @@ can be written as `_ : d` or as a bare `d`. ### Primitives - `%log` prints a string (list of `#Chr`) to stdout and returns `#Nil`. +- `%process_spawn(cmd)` returns `#OK{#Proc{id,seq}}` or `#ERR{String}`. +- `%process_poll(proc)` returns `#OK{#Pend{proc2}|#Rdy{proc2,#Exit{n}|#Sig{n}}}` or `#ERR{String}`. +- `%process_wait(proc)` returns `#OK{#Rdy{proc2,#Exit{n}|#Sig{n}}}` or `#ERR{String}`. +- `%process_kill(proc)` returns `#OK{#Pend{proc2}|#Rdy{...}}` or `#ERR{String}`. +- `%stream_stdin_open(seed)` returns `#OK{#Strm{id,0}}` or `#ERR{String}`. +- `%stream_file_open(path)` returns `#OK{#Strm{id,0}}` or `#ERR{String}`. +- `%stream_poll(strm)` returns `#OK{#Pend{strm2}|#Rdy{strm2,#Byt{n}|#Eof}}` or `#ERR{String}`. +- `%stream_wait(strm)` returns `#OK{#Rdy{strm2,#Byt{n}|#Eof}}` or `#ERR{String}`. +- `%stream_close(strm)` returns `#OK{#Nil}` or `#ERR{String}`. +- `%timer_start(ms)` returns `#OK{#Time{id,seq}}` or `#ERR{String}`. +- `%timer_poll(time)` returns `#OK{#Pend{time2}|#Rdy{time2}}` or `#ERR{String}`. +- `%timer_wait(time)` returns `#OK{#Rdy{time2}}` or `#ERR{String}`. ## Priority wrapper and wildcard diff --git a/test/prim_stream_close_bad_handle.hvm4 b/test/prim_stream_close_bad_handle.hvm4 new file mode 100644 index 00000000..f21eb1c8 --- /dev/null +++ b/test/prim_stream_close_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_close(#Strm{1,0}) +//EXPECT_CONTAINS:E2 unknown stream id diff --git a/test/prim_stream_close_era.hvm4 b/test/prim_stream_close_era.hvm4 new file mode 100644 index 00000000..aac44d6f --- /dev/null +++ b/test/prim_stream_close_era.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_close(&{}) +//!&{} diff --git a/test/prim_stream_close_ok.hvm4 b/test/prim_stream_close_ok.hvm4 new file mode 100644 index 00000000..8830a313 --- /dev/null +++ b/test/prim_stream_close_ok.hvm4 @@ -0,0 +1,4 @@ +@main = + !!x = %stream_file_open("/dev/null"); + %stream_close(#Strm{1,0}) +//!#OK{[]} diff --git a/test/prim_stream_close_stale.hvm4 b/test/prim_stream_close_stale.hvm4 new file mode 100644 index 00000000..81ae4fe3 --- /dev/null +++ b/test/prim_stream_close_stale.hvm4 @@ -0,0 +1,5 @@ +@main = + !!x = %stream_file_open("/dev/null"); + !!y = %stream_close(#Strm{1,0}); + %stream_close(#Strm{1,0}) +//EXPECT_CONTAINS:E3 stale stream handle diff --git a/test/prim_stream_file_open.hvm4 b/test/prim_stream_file_open.hvm4 new file mode 100644 index 00000000..773ea4d8 --- /dev/null +++ b/test/prim_stream_file_open.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_file_open("/dev/null") +//!#OK{#Strm{1,0}} diff --git a/test/prim_stream_file_open_era.hvm4 b/test/prim_stream_file_open_era.hvm4 new file mode 100644 index 00000000..dd84cbd2 --- /dev/null +++ b/test/prim_stream_file_open_era.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_file_open(&{}) +//!&{} diff --git a/test/prim_stream_file_open_inc.hvm4 b/test/prim_stream_file_open_inc.hvm4 new file mode 100644 index 00000000..b6a551b7 --- /dev/null +++ b/test/prim_stream_file_open_inc.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_file_open(↑"/dev/null") +//!↑#OK{#Strm{1,0}} diff --git a/test/prim_stream_file_open_missing.hvm4 b/test/prim_stream_file_open_missing.hvm4 new file mode 100644 index 00000000..f6e15b8a --- /dev/null +++ b/test/prim_stream_file_open_missing.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_file_open("/definitely_missing_hvm4_stream_file") +//EXPECT_CONTAINS:ERROR(stream_file_open): E5 diff --git a/test/prim_stream_file_open_sup.hvm4 b/test/prim_stream_file_open_sup.hvm4 new file mode 100644 index 00000000..fc482100 --- /dev/null +++ b/test/prim_stream_file_open_sup.hvm4 @@ -0,0 +1,2 @@ +@main = %stream_file_open(&L{"/dev/null", "/dev/null"}) +//!&L{#OK{#Strm{1,0}},#OK{#Strm{2,0}}} diff --git a/test/prim_stream_poll_closed.hvm4 b/test/prim_stream_poll_closed.hvm4 new file mode 100644 index 00000000..ce3dcb32 --- /dev/null +++ b/test/prim_stream_poll_closed.hvm4 @@ -0,0 +1,5 @@ +@main = + !!x = %stream_file_open("/dev/null"); + !!y = %stream_close(#Strm{1,0}); + %stream_poll(#Strm{1,1}) +//EXPECT_CONTAINS:E2 stream is closed diff --git a/test/prim_stream_poll_file_eof.hvm4 b/test/prim_stream_poll_file_eof.hvm4 new file mode 100644 index 00000000..2d8cabfc --- /dev/null +++ b/test/prim_stream_poll_file_eof.hvm4 @@ -0,0 +1,4 @@ +@main = + !!x = %stream_file_open("/dev/null"); + %stream_poll(#Strm{1,0}) +//!#OK{#Rdy{#Strm{1,1},#Eof{}}} diff --git a/test/prim_stream_wait_file_eof.hvm4 b/test/prim_stream_wait_file_eof.hvm4 new file mode 100644 index 00000000..188eb054 --- /dev/null +++ b/test/prim_stream_wait_file_eof.hvm4 @@ -0,0 +1,4 @@ +@main = + !!x = %stream_file_open("/dev/null"); + %stream_wait(#Strm{1,0}) +//!#OK{#Rdy{#Strm{1,1},#Eof{}}} From f98dd2529e48a097ce9567408ca96d0f61866453 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Tue, 10 Feb 2026 18:59:07 +0400 Subject: [PATCH 21/35] argv, chdir, cwd --- clang/hvm.c | 12 ++ clang/main.c | 13 +- clang/prim/fn/argv.c | 33 +++++ clang/prim/fn/chdir.c | 284 ++++++++++++++++++++++++++++++++++++++++++ clang/prim/fn/cwd.c | 24 ++++ clang/prim/init.c | 3 + 6 files changed, 367 insertions(+), 2 deletions(-) create mode 100644 clang/prim/fn/argv.c create mode 100644 clang/prim/fn/chdir.c create mode 100644 clang/prim/fn/cwd.c diff --git a/clang/hvm.c b/clang/hvm.c index 8b0fae93..65b15548 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -227,6 +227,15 @@ static u64 STEPS_ITRS_LIM = 0; static u64 STEPS_ROOT_LOC = 0; static str STEPS_LAST_ITR = NULL; +// Program args (tokens after bare `--` in CLI). +static int PRIM_ARGC = 0; +static char **PRIM_ARGV = NULL; + +fn void prim_set_argv(int argc, char **argv) { + PRIM_ARGC = argc; + PRIM_ARGV = argv; +} + // Nick Alphabet // ============= @@ -365,7 +374,10 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/log_go_1.c" #include "prim/fn/log_go_2.c" #include "prim/fn/panic.c" +#include "prim/fn/argv.c" #include "prim/fn/env.c" +#include "prim/fn/cwd.c" +#include "prim/fn/chdir.c" #include "prim/fn/rand.c" #include "prim/fn/uuid.c" #include "prim/fn/uid.c" diff --git a/clang/main.c b/clang/main.c index b1aae50b..840c96bb 100644 --- a/clang/main.c +++ b/clang/main.c @@ -36,6 +36,8 @@ typedef struct { u32 ffi_loads_len; RuntimeFfiLoad ffi_loads[RUNTIME_FFI_MAX]; char *file; + int prog_argc; + char **prog_argv; } CliOpts; // Returns the executable basename for help text. @@ -154,11 +156,17 @@ fn CliOpts parse_opts(int argc, char **argv) { .to_c = 0, .output = NULL, .ffi_loads_len = 0, - .file = NULL + .file = NULL, + .prog_argc = 0, + .prog_argv = NULL }; for (int i = 1; i < argc; i++) { - if (strcmp(argv[i], "-h") == 0 || strcmp(argv[i], "--help") == 0) { + if (strcmp(argv[i], "--") == 0) { + opts.prog_argc = argc - (i + 1); + opts.prog_argv = &argv[i + 1]; + break; + } else if (strcmp(argv[i], "-h") == 0 || strcmp(argv[i], "--help") == 0) { opts.help = 1; } else if (strcmp(argv[i], "-v") == 0 || strcmp(argv[i], "--version") == 0) { opts.version = 1; @@ -330,6 +338,7 @@ int main(int argc, char **argv) { threads = 1; } runtime_init(threads, opts.debug, opts.silent, opts.step_by_step); + prim_set_argv(opts.prog_argc, opts.prog_argv); // Load FFI libraries before parsing (needed for arity checks and overrides). int suppress_build_warnings = opts.as_c || opts.to_c || opts.output != NULL; diff --git a/clang/prim/fn/argv.c b/clang/prim/fn/argv.c new file mode 100644 index 00000000..86c570c5 --- /dev/null +++ b/clang/prim/fn/argv.c @@ -0,0 +1,33 @@ +// %argv(dummy) +// ------------ +// List with CLI args passed after bare `--`. +fn Term prim_fn_argv(Term *args) { + (void)args[0]; + + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term out = nil; + Term cur = nil; + u8 has_node = 0; + + for (int i = 0; i < PRIM_ARGC; i++) { + const char *arg = PRIM_ARGV[i]; + + Term str = term_string_from_utf8(arg); + Term h_t[2] = {str, nil}; + Term node = term_new_ctr(NAM_CON, 2, h_t); + + if (!has_node) { + out = node; + has_node = 1; + } else { + heap_set(term_val(cur) + 1, node); + } + cur = node; + } + + return out; +} + +fn void prim_argv_init(void) { + prim_register("argv", 4, 1, prim_fn_argv); +} diff --git a/clang/prim/fn/chdir.c b/clang/prim/fn/chdir.c new file mode 100644 index 00000000..051df750 --- /dev/null +++ b/clang/prim/fn/chdir.c @@ -0,0 +1,284 @@ +#include + +fn Term chdir_go_path(Term *args); +fn Term chdir_go_chr(Term *args); +fn Term chdir_go_num(Term *args); + +// %chdir(path) +// ------------ +// %chdir_go_path(λx.x, path) +fn Term prim_fn_chdir(Term *args) { + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term acc = term_new_lam_at(loc, var); + Term args0[2] = {acc, args[0]}; + Term t = term_new_pri(table_find("chdir_go_path", 13), 2, args0); + return wnf(t); +} + +// %chdir_go_path(acc, list) +// ------------------------- +// Walk list shape with lifting over ERA/INC/SUP. +fn Term chdir_go_path(Term *args) { + Term acc = args[0]; + Term list_wnf = wnf(args[1]); + + switch (term_tag(list_wnf)) { + case ERA: { + // %chdir_go_path(acc, &{}) + // ----------------------- chdir-go-path-era + // &{} + return term_new_era(); + } + case INC: { + // %chdir_go_path(acc, ↑x) + // ----------------------- chdir-go-path-inc + // ↑(%chdir(acc(x))) + u32 inc_loc = term_val(list_wnf); + Term inner = heap_read(inc_loc); + Term app = term_new_app(acc, inner); + Term next = term_new_pri(table_find("chdir", 5), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %chdir_go_path(acc, &L{x,y}) + // ---------------------------- chdir-go-path-sup + // &L{%chdir(acc0(x)), %chdir(acc1(y))} + u32 lab = term_ext(list_wnf); + u32 sup_loc = term_val(list_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Term app0 = term_new_app(A.k0, x); + Term app1 = term_new_app(A.k1, y); + Term t0 = term_new_pri(table_find("chdir", 5), 1, &app0); + Term t1 = term_new_pri(table_find("chdir", 5), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + // %chdir_go_path(acc, #Nil) + // ------------------------- chdir-go-path-nil + // %chdir_go_io(acc(#Nil)) + Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term path = term_new_app(acc, nil); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); + return wnf(io); + } + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + // %chdir_go_path(acc, #Con{h,t}) + // ------------------------------ chdir-go-path-con + // %chdir_go_chr(acc, h, t) + u32 con_loc = term_val(list_wnf); + Term head = heap_read(con_loc + 0); + Term tail = heap_read(con_loc + 1); + Term args0[3] = {acc, head, tail}; + Term t = term_new_pri(table_find("chdir_go_chr", 12), 3, args0); + return wnf(t); + } + // %chdir_go_path(acc, x) + // ---------------------- chdir-go-path-fallback + // fallthrough default + } + default: { + // %chdir_go_path(acc, x) + // ---------------------- chdir-go-path-default + // %chdir_go_io(acc(x)) + Term path = term_new_app(acc, list_wnf); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); + return wnf(io); + } + } +} + +// %chdir_go_chr(acc, head, tail) +// ------------------------------ +// Lift head over ERA/INC/SUP; on concrete #CHR{code}, continue with `code`. +fn Term chdir_go_chr(Term *args) { + Term acc = args[0]; + Term head_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(head_wnf)) { + case ERA: { + // %chdir_go_chr(acc, &{}, t) + // -------------------------- chdir-go-chr-era + // &{} + return term_new_era(); + } + case INC: { + // %chdir_go_chr(acc, ↑x, t) + // ------------------------- chdir-go-chr-inc + // ↑(%chdir(acc(#Con{x, t}))) + u32 inc_loc = term_val(head_wnf); + Term inner = heap_read(inc_loc); + Term con_args[2] = {inner, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("chdir", 5), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %chdir_go_chr(acc, &L{x,y}, t) + // ------------------------------ chdir-go-chr-sup + // &L{%chdir(acc0(#Con{x, t0})), %chdir(acc1(#Con{y, t1}))} + u32 lab = term_ext(head_wnf); + u32 sup_loc = term_val(head_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term con0_args[2] = {x, T.k0}; + Term con1_args[2] = {y, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("chdir", 5), 1, &app0); + Term t1 = term_new_pri(table_find("chdir", 5), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case C00 ... C16: { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + // %chdir_go_chr(acc, #Chr{c}, t) + // ------------------------------ chdir-go-chr-chr + // %chdir_go_num(acc, c, t) + u32 chr_loc = term_val(head_wnf); + Term code = heap_read(chr_loc + 0); + Term args0[3] = {acc, code, tail}; + Term t = term_new_pri(table_find("chdir_go_num", 12), 3, args0); + return wnf(t); + } + // %chdir_go_chr(acc, h, t) + // ------------------------- chdir-go-chr-fallback + // fallthrough default + } + default: { + // %chdir_go_chr(acc, h, t) + // ------------------------- chdir-go-chr-default + // %chdir_go_io(acc(#Con{h, t})) + Term con_args[2] = {head_wnf, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); + return wnf(io); + } + } +} + +// %chdir_go_num(acc, code, tail) +// ------------------------------ +// Lift code over ERA/INC/SUP; on concrete NUM, extend accumulator and continue. +fn Term chdir_go_num(Term *args) { + Term acc = args[0]; + Term code_wnf = wnf(args[1]); + Term tail = args[2]; + + switch (term_tag(code_wnf)) { + case ERA: { + // %chdir_go_num(acc, &{}, t) + // -------------------------- chdir-go-num-era + // &{} + return term_new_era(); + } + case INC: { + // %chdir_go_num(acc, ↑x, t) + // ------------------------- chdir-go-num-inc + // ↑(%chdir(acc(#Con{#Chr{x}, t}))) + u32 inc_loc = term_val(code_wnf); + Term inner = heap_read(inc_loc); + Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term app = term_new_app(acc, con); + Term next = term_new_pri(table_find("chdir", 5), 1, &app); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %chdir_go_num(acc, &L{x,y}, t) + // ------------------------------ chdir-go-num-sup + // &L{%chdir(acc0(#Con{#Chr{x}, t0})), %chdir(acc1(#Con{#Chr{y}, t1}))} + u32 lab = term_ext(code_wnf); + u32 sup_loc = term_val(code_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy A = term_clone(lab, acc); + Copy T = term_clone(lab, tail); + Term chr0 = term_new_ctr(NAM_CHR, 1, &x); + Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term con0_args[2] = {chr0, T.k0}; + Term con1_args[2] = {chr1, T.k1}; + Term con0 = term_new_ctr(NAM_CON, 2, con0_args); + Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term app0 = term_new_app(A.k0, con0); + Term app1 = term_new_app(A.k1, con1); + Term t0 = term_new_pri(table_find("chdir", 5), 1, &app0); + Term t1 = term_new_pri(table_find("chdir", 5), 1, &app1); + return term_new_sup(lab, t0, t1); + } + case NUM: { + // %chdir_go_num(acc, n, t) + // ------------------------ chdir-go-num-num + // %chdir_go_path(λx.acc(#Con{#Chr{n}, x}), t) + u64 loc = heap_alloc(1); + Term var = term_new_var(loc); + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, var}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term bod = term_new_app(acc, con); + Term acc_next = term_new_lam_at(loc, bod); + Term args0[2] = {acc_next, tail}; + Term t = term_new_pri(table_find("chdir_go_path", 13), 2, args0); + return wnf(t); + } + default: { + // %chdir_go_num(acc, c, t) + // ------------------------ chdir-go-num-default + // %chdir_go_io(acc(#Con{#Chr{c}, t})) + Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term con_args[2] = {chr, tail}; + Term con = term_new_ctr(NAM_CON, 2, con_args); + Term path = term_new_app(acc, con); + Term io_args[1] = {path}; + Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); + return wnf(io); + } + } +} + +// %chdir_go_io(path) +// ------------------ +// #OK{#NIL} | #ERR{String} +fn Term prim_fn_chdir_go_io(Term *args) { + int MAX_PATH = 1024; + char path[MAX_PATH]; // UTF-8 bytes + const char *CHDIR_ERR_FMT = "ERROR(chdir): failed to change directory to '%s': %s (errno=%d)"; + + // Decode HVM path string (#CHR list) into `path` as UTF-8 bytes. + HStrErr path_err; + if (!term_string_to_utf8_cstr(args[0], path, MAX_PATH, NULL, &path_err)) { + return term_string_from_hstrerr("chdir", "path", MAX_PATH, path_err); + } + + if (chdir(path) != 0) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(CHDIR_ERR_FMT, path, strerror(err), err) }); + } + + Term Nil = term_new_ctr(NAM_NIL, 0, 0); + return term_new_ctr(NAM_OK, 1, &Nil); +} + +fn void prim_chdir_init(void) { + prim_register("chdir", 5, 1, prim_fn_chdir); + prim_register("chdir_go_path", 13, 2, chdir_go_path); + prim_register("chdir_go_chr", 12, 3, chdir_go_chr); + prim_register("chdir_go_num", 12, 3, chdir_go_num); + prim_register("chdir_go_io", 11, 1, prim_fn_chdir_go_io); +} diff --git a/clang/prim/fn/cwd.c b/clang/prim/fn/cwd.c new file mode 100644 index 00000000..da639efa --- /dev/null +++ b/clang/prim/fn/cwd.c @@ -0,0 +1,24 @@ +#include + +// %cwd(dummy) +// ----------- +// #OK{String} | #ERR{String} +fn Term prim_fn_cwd(Term *args) { + (void)args[0]; + + int MAX_CWD = 4096; + char cwd[MAX_CWD]; // UTF-8 bytes + const char *GETCWD_ERR_FMT = "ERROR(cwd): failed to get current directory: %s (errno=%d)"; + + if (getcwd(cwd, MAX_CWD) == NULL) { + int err = errno; + return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(GETCWD_ERR_FMT, strerror(err), err) }); + } + + Term out = term_string_from_utf8(cwd); + return term_new_ctr(NAM_OK, 1, &out); +} + +fn void prim_cwd_init(void) { + prim_register("cwd", 3, 1, prim_fn_cwd); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index bec89cbe..63b7b97e 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -1,6 +1,7 @@ fn void prim_init(void) { prim_log_init(); prim_panic_init(); + prim_argv_init(); prim_rand_init(); prim_uuid_init(); prim_uid_init(); @@ -8,6 +9,8 @@ fn void prim_init(void) { prim_stream_init(); prim_timer_init(); prim_env_init(); + prim_cwd_init(); + prim_chdir_init(); prim_read_bytes_init(); prim_write_bytes_init(); prim_read_file_init(); From 9f3f84e148d91e63901e47bbd7e1202f8eeacd59 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 10 Feb 2026 15:34:25 -0300 Subject: [PATCH 22/35] https prim --- clang/hvm.c | 1 + clang/prim/fn/https/_.c | 548 +++++++++++++++++++++++++ clang/prim/fn/https/cancel.c | 137 +++++++ clang/prim/fn/https/get.c | 209 ++++++++++ clang/prim/fn/https/poll.c | 127 ++++++ clang/prim/fn/https/wait.c | 123 ++++++ clang/prim/init.c | 1 + docs/hvm/core.md | 5 +- docs/hvm/syntax.md | 4 + test/prim_https_cancel_bad_handle.hvm4 | 2 + test/prim_https_get_bad_arg.hvm4 | 2 + test/prim_https_poll_bad_handle.hvm4 | 2 + test/prim_https_wait_era.hvm4 | 2 + 13 files changed, 1162 insertions(+), 1 deletion(-) create mode 100644 clang/prim/fn/https/_.c create mode 100644 clang/prim/fn/https/cancel.c create mode 100644 clang/prim/fn/https/get.c create mode 100644 clang/prim/fn/https/poll.c create mode 100644 clang/prim/fn/https/wait.c create mode 100644 test/prim_https_cancel_bad_handle.hvm4 create mode 100644 test/prim_https_get_bad_arg.hvm4 create mode 100644 test/prim_https_poll_bad_handle.hvm4 create mode 100644 test/prim_https_wait_era.hvm4 diff --git a/clang/hvm.c b/clang/hvm.c index 65b15548..de352b6a 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -383,6 +383,7 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/uid.c" #include "prim/fn/process/_.c" #include "prim/fn/stream/_.c" +#include "prim/fn/https/_.c" #include "prim/fn/read_bytes.c" #include "prim/fn/write_bytes.c" #include "prim/fn/read_file.c" diff --git a/clang/prim/fn/https/_.c b/clang/prim/fn/https/_.c new file mode 100644 index 00000000..59e7530b --- /dev/null +++ b/clang/prim/fn/https/_.c @@ -0,0 +1,548 @@ +#include +#include +#include +#include + +#define HTTPS_CAP (1u << 18) +#define HTTPS_BODY_CAP (1u << 20) + +#define HTTPS_ERR_BAD_ARG 1 +#define HTTPS_ERR_BAD_HANDLE 2 +#define HTTPS_ERR_STALE 3 +#define HTTPS_ERR_FULL 4 +#define HTTPS_ERR_IO 5 + +#define HTTPS_FAIL_CURL_EXIT 1 +#define HTTPS_FAIL_CURL_SIGNAL 2 +#define HTTPS_FAIL_PARSE 3 +#define HTTPS_FAIL_BODY 4 + +typedef struct { + u32 expected_seq; + pid_t pid; + u8 finished; + u8 canceled; + u8 signaled; + u8 parsed; + u32 code; + Term outcome; + + char *tmp_dir; + char *hdr_path; + char *body_path; + char *meta_path; + char *err_path; +} HttpsSlot; + +static HttpsSlot HTTPS_SLOTS[HTTPS_CAP]; +static u32 HTTPS_NEXT_ID = 1; +static pthread_mutex_t HTTPS_LOCK = PTHREAD_MUTEX_INITIALIZER; + +static u32 HTTPS_NAM_HTTP = 0; +static u32 HTTPS_NAM_PEND = 0; +static u32 HTTPS_NAM_RDY = 0; +static u32 HTTPS_NAM_RESP = 0; +static u32 HTTPS_NAM_HDR = 0; +static u32 HTTPS_NAM_FAIL = 0; +static u32 HTTPS_NAM_CANCELED = 0; + +fn Term wnf(Term term); + +fn Term https_new_err(const char *prim, u32 code, const char *msg) { + Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); + return term_new_ctr(NAM_ERR, 1, &txt); +} + +fn Term https_new_ok(Term val) { + return term_new_ctr(NAM_OK, 1, &val); +} + +fn Term https_new_http(u32 id, u32 seq) { + Term args[2] = {term_new_num(id), term_new_num(seq)}; + return term_new_ctr(HTTPS_NAM_HTTP, 2, args); +} + +fn Term https_new_pend(u32 id, u32 seq) { + Term http = https_new_http(id, seq); + return term_new_ctr(HTTPS_NAM_PEND, 1, &http); +} + +fn Term https_new_rdy(u32 id, u32 seq, Term outcome) { + Term http = https_new_http(id, seq); + Term args[2] = {http, outcome}; + return term_new_ctr(HTTPS_NAM_RDY, 2, args); +} + +fn Term https_new_fail(u32 code, Term msg) { + Term args[2] = {term_new_num(code), msg}; + return term_new_ctr(HTTPS_NAM_FAIL, 2, args); +} + +fn Term https_new_canceled(void) { + return term_new_ctr(HTTPS_NAM_CANCELED, 0, NULL); +} + +fn Term https_new_resp(u32 status, Term headers, Term body) { + Term args[3] = {term_new_num(status), headers, body}; + return term_new_ctr(HTTPS_NAM_RESP, 3, args); +} + +fn u8 https_parse_num(Term term, u32 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case NUM: { + *out = term_val(val); + return 1; + } + default: { + return 0; + } + } +} + +fn u8 https_parse_handle(Term term, u32 *id, u32 *seq) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C02: { + if (term_ext(val) != HTTPS_NAM_HTTP) { + return 0; + } + + u32 loc = term_val(val); + Term id_tm = heap_read(loc + 0); + Term seq_tm = heap_read(loc + 1); + + if (!https_parse_num(id_tm, id)) { + return 0; + } + if (!https_parse_num(seq_tm, seq)) { + return 0; + } + return 1; + } + default: { + return 0; + } + } +} + +fn u8 https_is_valid_id(u32 id) { + pthread_mutex_lock(&HTTPS_LOCK); + + if (id == 0 || id >= HTTPS_NEXT_ID || id >= HTTPS_CAP) { + pthread_mutex_unlock(&HTTPS_LOCK); + return 0; + } + + pthread_mutex_unlock(&HTTPS_LOCK); + return 1; +} + +fn void https_set_finished(u32 id, u8 signaled, u32 code) { + pthread_mutex_lock(&HTTPS_LOCK); + + if (id != 0 && id < HTTPS_NEXT_ID && id < HTTPS_CAP) { + HttpsSlot *slot = &HTTPS_SLOTS[id]; + slot->finished = 1; + slot->signaled = signaled; + slot->code = code; + } + + pthread_mutex_unlock(&HTTPS_LOCK); +} + +fn void https_set_canceled(u32 id) { + pthread_mutex_lock(&HTTPS_LOCK); + + if (id != 0 && id < HTTPS_NEXT_ID && id < HTTPS_CAP) { + HTTPS_SLOTS[id].canceled = 1; + } + + pthread_mutex_unlock(&HTTPS_LOCK); +} + +fn void https_status_from_wait(int status, u8 *signaled, u32 *code) { + if (WIFEXITED(status)) { + *signaled = 0; + *code = (u32)WEXITSTATUS(status); + return; + } + + if (WIFSIGNALED(status)) { + *signaled = 1; + *code = (u32)WTERMSIG(status); + return; + } + + *signaled = 0; + *code = 255; +} + +fn char *https_strdup(const char *str) { + size_t len = strlen(str); + char *out = malloc(len + 1); + if (!out) { + return NULL; + } + + memcpy(out, str, len); + out[len] = '\0'; + return out; +} + +fn char *https_join_path(const char *dir, const char *name) { + size_t dlen = strlen(dir); + size_t nlen = strlen(name); + char *out = malloc(dlen + 1 + nlen + 1); + if (!out) { + return NULL; + } + + memcpy(out, dir, dlen); + out[dlen] = '/'; + memcpy(out + dlen + 1, name, nlen); + out[dlen + 1 + nlen] = '\0'; + return out; +} + +fn void https_paths_free( + char **tmp_dir, + char **hdr_path, + char **body_path, + char **meta_path, + char **err_path +) { + if (*hdr_path) { + unlink(*hdr_path); + free(*hdr_path); + *hdr_path = NULL; + } + if (*body_path) { + unlink(*body_path); + free(*body_path); + *body_path = NULL; + } + if (*meta_path) { + unlink(*meta_path); + free(*meta_path); + *meta_path = NULL; + } + if (*err_path) { + unlink(*err_path); + free(*err_path); + *err_path = NULL; + } + if (*tmp_dir) { + rmdir(*tmp_dir); + free(*tmp_dir); + *tmp_dir = NULL; + } +} + +fn void https_slot_cleanup(HttpsSlot *slot) { + https_paths_free( + &slot->tmp_dir, + &slot->hdr_path, + &slot->body_path, + &slot->meta_path, + &slot->err_path + ); +} + +fn u8 https_make_paths( + char **tmp_dir, + char **hdr_path, + char **body_path, + char **meta_path, + char **err_path +) { + char tmpl[] = "/tmp/hvm4_https_XXXXXX"; + char *dir = https_strdup(tmpl); + if (!dir) { + return 0; + } + + if (!mkdtemp(dir)) { + free(dir); + return 0; + } + + char *hdr = https_join_path(dir, "headers.txt"); + char *body = https_join_path(dir, "body.bin"); + char *meta = https_join_path(dir, "meta.txt"); + char *err = https_join_path(dir, "err.txt"); + if (!hdr || !body || !meta || !err) { + https_paths_free(&dir, &hdr, &body, &meta, &err); + return 0; + } + + *tmp_dir = dir; + *hdr_path = hdr; + *body_path = body; + *meta_path = meta; + *err_path = err; + return 1; +} + +fn u8 https_read_status_code(const char *meta_path, u32 *status) { + FILE *f = fopen(meta_path, "rb"); + if (!f) { + return 0; + } + + char buf[64]; + size_t got = fread(buf, 1, sizeof(buf) - 1, f); + fclose(f); + buf[got] = '\0'; + + char *p = buf; + while (*p && !isdigit((unsigned char)*p)) { + p++; + } + + if (!*p) { + return 0; + } + + long code = strtol(p, NULL, 10); + if (code < 0 || code > 9999) { + return 0; + } + + *status = (u32)code; + return 1; +} + +fn Term https_read_stderr_msg(const char *err_path, const char *fallback) { + FILE *f = fopen(err_path, "rb"); + if (!f) { + return term_string_from_utf8(fallback); + } + + char buf[1024]; + size_t got = fread(buf, 1, sizeof(buf) - 1, f); + fclose(f); + + while (got > 0 && (buf[got - 1] == '\n' || buf[got - 1] == '\r')) { + got--; + } + buf[got] = '\0'; + + if (got == 0) { + return term_string_from_utf8(fallback); + } + + return term_string_from_utf8(buf); +} + +fn u8 https_read_body_bytes(const char *body_path, Term *body_out, Term *err_msg_out) { + FILE *f = fopen(body_path, "rb"); + if (!f) { + int err = errno; + *err_msg_out = term_string_printf( + "failed to open body file '%s': %s (errno=%d)", + body_path, + strerror(err), + err + ); + return 0; + } + + Term nil = term_new_ctr(NAM_NIL, 0, NULL); + unsigned char c = 0; + if (fread(&c, 1, 1, f) != 1) { + if (ferror(f)) { + int err = errno; + fclose(f); + *err_msg_out = term_string_printf( + "failed to read body file '%s': %s (errno=%d)", + body_path, + strerror(err), + err + ); + return 0; + } + fclose(f); + *body_out = nil; + return 1; + } + + u32 count = 1; + Term byt[1] = {term_new_num(c)}; + Term head_tail[2] = {term_new_ctr(NAM_BYT, 1, byt), nil}; + Term result = term_new_ctr(NAM_CON, 2, head_tail); + Term curr = result; + + while (fread(&c, 1, 1, f) == 1) { + count++; + if (count > HTTPS_BODY_CAP) { + fclose(f); + *err_msg_out = term_string_printf("response body too large (max %u bytes)", HTTPS_BODY_CAP); + return 0; + } + + byt[0] = term_new_num(c); + head_tail[0] = term_new_ctr(NAM_BYT, 1, byt); + heap_set(term_val(curr) + 1, term_new_ctr(NAM_CON, 2, head_tail)); + curr = heap_read(term_val(curr) + 1); + } + + if (ferror(f)) { + int err = errno; + fclose(f); + *err_msg_out = term_string_printf( + "failed to read body file '%s': %s (errno=%d)", + body_path, + strerror(err), + err + ); + return 0; + } + + fclose(f); + *body_out = result; + return 1; +} + +fn Term https_build_outcome( + u8 canceled, + u8 signaled, + u32 code, + const char *meta_path, + const char *body_path, + const char *err_path +) { + if (canceled) { + return https_new_canceled(); + } + + if (signaled) { + Term msg = term_string_printf("curl terminated by signal %u", code); + return https_new_fail(HTTPS_FAIL_CURL_SIGNAL, msg); + } + + if (code != 0) { + Term msg = https_read_stderr_msg(err_path, "curl request failed"); + return https_new_fail(HTTPS_FAIL_CURL_EXIT, msg); + } + + u32 status = 0; + if (!https_read_status_code(meta_path, &status)) { + Term msg = term_string_printf("failed to parse status from '%s'", meta_path); + return https_new_fail(HTTPS_FAIL_PARSE, msg); + } + + Term body = term_new_era(); + Term body_err = term_new_era(); + if (!https_read_body_bytes(body_path, &body, &body_err)) { + return https_new_fail(HTTPS_FAIL_BODY, body_err); + } + + Term headers = term_new_ctr(NAM_NIL, 0, NULL); + return https_new_resp(status, headers, body); +} + +fn void https_set_outcome(u32 id, Term outcome) { + pthread_mutex_lock(&HTTPS_LOCK); + + if (id != 0 && id < HTTPS_NEXT_ID && id < HTTPS_CAP) { + HttpsSlot *slot = &HTTPS_SLOTS[id]; + slot->outcome = outcome; + slot->parsed = 1; + https_slot_cleanup(slot); + } + + pthread_mutex_unlock(&HTTPS_LOCK); +} + +fn pid_t https_waitpid_retry(pid_t pid, int *status, int opts) { + while (1) { + pid_t got = waitpid(pid, status, opts); + if (got >= 0) { + return got; + } + if (errno == EINTR) { + continue; + } + return -1; + } +} + +fn Term https_parse_and_store_outcome( + u32 id, + u8 canceled, + u8 signaled, + u32 code, + const char *meta_path, + const char *body_path, + const char *err_path +) { + Term outcome = https_build_outcome(canceled, signaled, code, meta_path, body_path, err_path); + https_set_outcome(id, outcome); + return outcome; +} + +fn u8 https_claim( + u32 id, + u32 seq, + pid_t *pid, + u8 *finished, + u8 *parsed, + u8 *canceled, + u8 *signaled, + u32 *code, + Term *outcome, + char **body_path, + char **meta_path, + char **err_path +) { + pthread_mutex_lock(&HTTPS_LOCK); + + if (id == 0 || id >= HTTPS_NEXT_ID || id >= HTTPS_CAP) { + pthread_mutex_unlock(&HTTPS_LOCK); + return 0; + } + + HttpsSlot *slot = &HTTPS_SLOTS[id]; + if (slot->expected_seq != seq) { + pthread_mutex_unlock(&HTTPS_LOCK); + return 0; + } + + slot->expected_seq = seq + 1; + *pid = slot->pid; + *finished = slot->finished; + *parsed = slot->parsed; + *canceled = slot->canceled; + *signaled = slot->signaled; + *code = slot->code; + *outcome = slot->outcome; + *body_path = slot->body_path; + *meta_path = slot->meta_path; + *err_path = slot->err_path; + + pthread_mutex_unlock(&HTTPS_LOCK); + return 1; +} + +#include "get.c" +#include "poll.c" +#include "wait.c" +#include "cancel.c" + +fn void prim_https_init(void) { + HTTPS_NAM_HTTP = nick_from_str("Http", 4); + HTTPS_NAM_PEND = nick_from_str("Pend", 4); + HTTPS_NAM_RDY = nick_from_str("Rdy", 3); + HTTPS_NAM_RESP = nick_from_str("Resp", 4); + HTTPS_NAM_HDR = nick_from_str("Hdr", 3); + HTTPS_NAM_FAIL = nick_from_str("Fail", 4); + HTTPS_NAM_CANCELED = nick_from_str("Canceled", 8); + + prim_https_get_init(); + prim_https_poll_init(); + prim_https_wait_init(); + prim_https_cancel_init(); +} diff --git a/clang/prim/fn/https/cancel.c b/clang/prim/fn/https/cancel.c new file mode 100644 index 00000000..d5c018db --- /dev/null +++ b/clang/prim/fn/https/cancel.c @@ -0,0 +1,137 @@ +// %https_cancel(http) +// ------------------- +// %https_cancel_go_http(http) +fn Term prim_fn_https_cancel(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("https_cancel_go_http", 20), 1, args0); + return wnf(t); +} + +// %https_cancel_go_http(http) +// --------------------------- +// Lift `http` over ERA/INC/SUP; default forwards to io stage. +fn Term https_cancel_go_http(Term *args) { + Term http_wnf = wnf(args[0]); + + switch (term_tag(http_wnf)) { + case ERA: { + // %https_cancel_go_http(&{}) + // -------------------------- https-cancel-go-http-era + // &{} + return term_new_era(); + } + case INC: { + // %https_cancel_go_http(↑x) + // ------------------------- https-cancel-go-http-inc + // ↑(%https_cancel(x)) + u32 inc_loc = term_val(http_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("https_cancel", 12), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %https_cancel_go_http(&L{x,y}) + // ------------------------------ https-cancel-go-http-sup + // &L{%https_cancel(x), %https_cancel(y)} + u32 lab = term_ext(http_wnf); + u32 sup_loc = term_val(http_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("https_cancel", 12), 1, &x); + Term t1 = term_new_pri(table_find("https_cancel", 12), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %https_cancel_go_http(http) + // --------------------------- https-cancel-go-http-default + // %https_cancel_go_io(http) + Term args0[1] = {http_wnf}; + Term t = term_new_pri(table_find("https_cancel_go_io", 18), 1, args0); + return wnf(t); + } + } +} + +// %https_cancel_go_io(http) +// ------------------------- +// #OK{#Pend{#Http{id,seq+1}}|#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} +fn Term prim_fn_https_cancel_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!https_parse_handle(args[0], &id, &seq)) { + return https_new_err("https_cancel", HTTPS_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); + } + + if (!https_is_valid_id(id)) { + return https_new_err("https_cancel", HTTPS_ERR_BAD_HANDLE, "unknown https id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 parsed = 0; + u8 canceled = 0; + u8 signaled = 0; + u32 code = 0; + Term outcome = term_new_era(); + char *body = NULL; + char *meta = NULL; + char *err = NULL; + if (!https_claim( + id, + seq, + &pid, + &finished, + &parsed, + &canceled, + &signaled, + &code, + &outcome, + &body, + &meta, + &err + )) { + return https_new_err("https_cancel", HTTPS_ERR_STALE, "stale https handle"); + } + + if (parsed) { + return https_new_ok(https_new_rdy(id, seq + 1, outcome)); + } + + if (finished) { + Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); + } + + https_set_canceled(id); + + if (kill(pid, SIGTERM) < 0 && errno != ESRCH) { + return https_new_err("https_cancel", HTTPS_ERR_IO, strerror(errno)); + } + + int status = 0; + pid_t got = https_waitpid_retry(pid, &status, WNOHANG); + if (got < 0) { + if (errno == ECHILD) { + Term done = https_parse_and_store_outcome(id, 1, 0, 0, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); + } + return https_new_err("https_cancel", HTTPS_ERR_IO, strerror(errno)); + } + + if (got == 0) { + return https_new_ok(https_new_pend(id, seq + 1)); + } + + https_status_from_wait(status, &signaled, &code); + https_set_finished(id, signaled, code); + + Term done = https_parse_and_store_outcome(id, 1, signaled, code, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); +} + +fn void prim_https_cancel_init(void) { + prim_register("https_cancel", 12, 1, prim_fn_https_cancel); + prim_register("https_cancel_go_http", 20, 1, https_cancel_go_http); + prim_register("https_cancel_go_io", 18, 1, prim_fn_https_cancel_go_io); +} diff --git a/clang/prim/fn/https/get.c b/clang/prim/fn/https/get.c new file mode 100644 index 00000000..e923a370 --- /dev/null +++ b/clang/prim/fn/https/get.c @@ -0,0 +1,209 @@ +// %https_get(url) +// --------------- +// %https_get_go_url(url) +fn Term prim_fn_https_get(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("https_get_go_url", 16), 1, args0); + return wnf(t); +} + +// %https_get_go_url(url) +// ---------------------- +// Lift `url` over ERA/INC/SUP; default forwards to io stage. +fn Term https_get_go_url(Term *args) { + Term url_wnf = wnf(args[0]); + + switch (term_tag(url_wnf)) { + case ERA: { + // %https_get_go_url(&{}) + // ---------------------- https-get-go-url-era + // &{} + return term_new_era(); + } + case INC: { + // %https_get_go_url(↑x) + // --------------------- https-get-go-url-inc + // ↑(%https_get(x)) + u32 inc_loc = term_val(url_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("https_get", 9), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %https_get_go_url(&L{x,y}) + // -------------------------- https-get-go-url-sup + // &L{%https_get(x), %https_get(y)} + u32 lab = term_ext(url_wnf); + u32 sup_loc = term_val(url_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("https_get", 9), 1, &x); + Term t1 = term_new_pri(table_find("https_get", 9), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %https_get_go_url(url) + // ---------------------- https-get-go-url-default + // %https_get_go_io(url) + Term args0[1] = {url_wnf}; + Term t = term_new_pri(table_find("https_get_go_io", 15), 1, args0); + return wnf(t); + } + } +} + +fn int https_open_trunc_file(const char *path) { + while (1) { + int fd = open(path, O_WRONLY | O_CREAT | O_TRUNC, 0600); + if (fd >= 0) { + return fd; + } + if (errno == EINTR) { + continue; + } + return -1; + } +} + +fn int https_dup2_retry(int old_fd, int new_fd) { + while (1) { + if (dup2(old_fd, new_fd) >= 0) { + return 1; + } + if (errno == EINTR) { + continue; + } + return 0; + } +} + +fn void https_child_exec_get( + const char *url, + const char *hdr_path, + const char *body_path, + const char *meta_path, + const char *err_path +) { + int meta_fd = https_open_trunc_file(meta_path); + if (meta_fd < 0) { + _exit(127); + } + + int err_fd = https_open_trunc_file(err_path); + if (err_fd < 0) { + close(meta_fd); + _exit(127); + } + + if (!https_dup2_retry(meta_fd, STDOUT_FILENO)) { + close(meta_fd); + close(err_fd); + _exit(127); + } + + if (!https_dup2_retry(err_fd, STDERR_FILENO)) { + close(meta_fd); + close(err_fd); + _exit(127); + } + + close(meta_fd); + close(err_fd); + + execlp( + "curl", + "curl", + "-sS", + "-L", + "-D", hdr_path, + "-o", body_path, + "-w", "%{http_code}\n", + url, + (char *)NULL + ); + + _exit(127); +} + +// %https_get_go_io(url) +// --------------------- +// #OK{#Http{id,0}} | #ERR{String} +fn Term prim_fn_https_get_go_io(Term *args) { + int MAX_URL = 8192; + char url[MAX_URL]; + + HStrErr url_err; + if (!term_string_to_utf8_cstr(args[0], url, MAX_URL, NULL, &url_err)) { + return term_string_from_hstrerr("https_get", "url", MAX_URL, url_err); + } + + char *tmp_dir = NULL; + char *hdr_path = NULL; + char *body_path = NULL; + char *meta_path = NULL; + char *err_path = NULL; + + if (!https_make_paths(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path)) { + return https_new_err("https_get", HTTPS_ERR_IO, "failed to allocate temporary files"); + } + + pid_t pid = fork(); + if (pid < 0) { + int err = errno; + https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); + return https_new_err("https_get", HTTPS_ERR_IO, strerror(err)); + } + + if (pid == 0) { + https_child_exec_get(url, hdr_path, body_path, meta_path, err_path); + } + + pthread_mutex_lock(&HTTPS_LOCK); + + u32 id = HTTPS_NEXT_ID; + if (id >= HTTPS_CAP) { + pthread_mutex_unlock(&HTTPS_LOCK); + + if (kill(pid, SIGKILL) < 0 && errno != ESRCH) { + https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); + return https_new_err("https_get", HTTPS_ERR_IO, strerror(errno)); + } + + int status = 0; + pid_t got = https_waitpid_retry(pid, &status, 0); + if (got < 0 && errno != ECHILD) { + https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); + return https_new_err("https_get", HTTPS_ERR_IO, strerror(errno)); + } + + https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); + return https_new_err("https_get", HTTPS_ERR_FULL, "https table is full"); + } + + HTTPS_NEXT_ID = id + 1; + + HttpsSlot *slot = &HTTPS_SLOTS[id]; + slot->expected_seq = 0; + slot->pid = pid; + slot->finished = 0; + slot->canceled = 0; + slot->signaled = 0; + slot->parsed = 0; + slot->code = 0; + slot->outcome = term_new_era(); + slot->tmp_dir = tmp_dir; + slot->hdr_path = hdr_path; + slot->body_path = body_path; + slot->meta_path = meta_path; + slot->err_path = err_path; + + pthread_mutex_unlock(&HTTPS_LOCK); + return https_new_ok(https_new_http(id, 0)); +} + +fn void prim_https_get_init(void) { + prim_register("https_get", 9, 1, prim_fn_https_get); + prim_register("https_get_go_url", 16, 1, https_get_go_url); + prim_register("https_get_go_io", 15, 1, prim_fn_https_get_go_io); +} diff --git a/clang/prim/fn/https/poll.c b/clang/prim/fn/https/poll.c new file mode 100644 index 00000000..751f476b --- /dev/null +++ b/clang/prim/fn/https/poll.c @@ -0,0 +1,127 @@ +// %https_poll(http) +// ----------------- +// %https_poll_go_http(http) +fn Term prim_fn_https_poll(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("https_poll_go_http", 18), 1, args0); + return wnf(t); +} + +// %https_poll_go_http(http) +// ------------------------- +// Lift `http` over ERA/INC/SUP; default forwards to io stage. +fn Term https_poll_go_http(Term *args) { + Term http_wnf = wnf(args[0]); + + switch (term_tag(http_wnf)) { + case ERA: { + // %https_poll_go_http(&{}) + // ------------------------ https-poll-go-http-era + // &{} + return term_new_era(); + } + case INC: { + // %https_poll_go_http(↑x) + // ----------------------- https-poll-go-http-inc + // ↑(%https_poll(x)) + u32 inc_loc = term_val(http_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("https_poll", 10), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %https_poll_go_http(&L{x,y}) + // ---------------------------- https-poll-go-http-sup + // &L{%https_poll(x), %https_poll(y)} + u32 lab = term_ext(http_wnf); + u32 sup_loc = term_val(http_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("https_poll", 10), 1, &x); + Term t1 = term_new_pri(table_find("https_poll", 10), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %https_poll_go_http(http) + // ------------------------- https-poll-go-http-default + // %https_poll_go_io(http) + Term args0[1] = {http_wnf}; + Term t = term_new_pri(table_find("https_poll_go_io", 16), 1, args0); + return wnf(t); + } + } +} + +// %https_poll_go_io(http) +// ----------------------- +// #OK{#Pend{#Http{id,seq+1}}|#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} +fn Term prim_fn_https_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!https_parse_handle(args[0], &id, &seq)) { + return https_new_err("https_poll", HTTPS_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); + } + + if (!https_is_valid_id(id)) { + return https_new_err("https_poll", HTTPS_ERR_BAD_HANDLE, "unknown https id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 parsed = 0; + u8 canceled = 0; + u8 signaled = 0; + u32 code = 0; + Term outcome = term_new_era(); + char *body = NULL; + char *meta = NULL; + char *err = NULL; + if (!https_claim( + id, + seq, + &pid, + &finished, + &parsed, + &canceled, + &signaled, + &code, + &outcome, + &body, + &meta, + &err + )) { + return https_new_err("https_poll", HTTPS_ERR_STALE, "stale https handle"); + } + + if (parsed) { + return https_new_ok(https_new_rdy(id, seq + 1, outcome)); + } + + if (finished) { + Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); + } + + int status = 0; + pid_t got = https_waitpid_retry(pid, &status, WNOHANG); + if (got < 0) { + return https_new_err("https_poll", HTTPS_ERR_IO, strerror(errno)); + } + + if (got == 0) { + return https_new_ok(https_new_pend(id, seq + 1)); + } + + https_status_from_wait(status, &signaled, &code); + https_set_finished(id, signaled, code); + + Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); +} + +fn void prim_https_poll_init(void) { + prim_register("https_poll", 10, 1, prim_fn_https_poll); + prim_register("https_poll_go_http", 18, 1, https_poll_go_http); + prim_register("https_poll_go_io", 16, 1, prim_fn_https_poll_go_io); +} diff --git a/clang/prim/fn/https/wait.c b/clang/prim/fn/https/wait.c new file mode 100644 index 00000000..fef58973 --- /dev/null +++ b/clang/prim/fn/https/wait.c @@ -0,0 +1,123 @@ +// %https_wait(http) +// ----------------- +// %https_wait_go_http(http) +fn Term prim_fn_https_wait(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("https_wait_go_http", 18), 1, args0); + return wnf(t); +} + +// %https_wait_go_http(http) +// ------------------------- +// Lift `http` over ERA/INC/SUP; default forwards to io stage. +fn Term https_wait_go_http(Term *args) { + Term http_wnf = wnf(args[0]); + + switch (term_tag(http_wnf)) { + case ERA: { + // %https_wait_go_http(&{}) + // ------------------------ https-wait-go-http-era + // &{} + return term_new_era(); + } + case INC: { + // %https_wait_go_http(↑x) + // ----------------------- https-wait-go-http-inc + // ↑(%https_wait(x)) + u32 inc_loc = term_val(http_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("https_wait", 10), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %https_wait_go_http(&L{x,y}) + // ---------------------------- https-wait-go-http-sup + // &L{%https_wait(x), %https_wait(y)} + u32 lab = term_ext(http_wnf); + u32 sup_loc = term_val(http_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("https_wait", 10), 1, &x); + Term t1 = term_new_pri(table_find("https_wait", 10), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %https_wait_go_http(http) + // ------------------------- https-wait-go-http-default + // %https_wait_go_io(http) + Term args0[1] = {http_wnf}; + Term t = term_new_pri(table_find("https_wait_go_io", 16), 1, args0); + return wnf(t); + } + } +} + +// %https_wait_go_io(http) +// ----------------------- +// #OK{#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} +fn Term prim_fn_https_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!https_parse_handle(args[0], &id, &seq)) { + return https_new_err("https_wait", HTTPS_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); + } + + if (!https_is_valid_id(id)) { + return https_new_err("https_wait", HTTPS_ERR_BAD_HANDLE, "unknown https id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 parsed = 0; + u8 canceled = 0; + u8 signaled = 0; + u32 code = 0; + Term outcome = term_new_era(); + char *body = NULL; + char *meta = NULL; + char *err = NULL; + if (!https_claim( + id, + seq, + &pid, + &finished, + &parsed, + &canceled, + &signaled, + &code, + &outcome, + &body, + &meta, + &err + )) { + return https_new_err("https_wait", HTTPS_ERR_STALE, "stale https handle"); + } + + if (parsed) { + return https_new_ok(https_new_rdy(id, seq + 1, outcome)); + } + + if (finished) { + Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); + } + + int status = 0; + pid_t got = https_waitpid_retry(pid, &status, 0); + if (got < 0) { + return https_new_err("https_wait", HTTPS_ERR_IO, strerror(errno)); + } + + https_status_from_wait(status, &signaled, &code); + https_set_finished(id, signaled, code); + + Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); + return https_new_ok(https_new_rdy(id, seq + 1, done)); +} + +fn void prim_https_wait_init(void) { + prim_register("https_wait", 10, 1, prim_fn_https_wait); + prim_register("https_wait_go_http", 18, 1, https_wait_go_http); + prim_register("https_wait_go_io", 16, 1, prim_fn_https_wait_go_io); +} diff --git a/clang/prim/init.c b/clang/prim/init.c index 63b7b97e..6417ef8a 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -8,6 +8,7 @@ fn void prim_init(void) { prim_process_init(); prim_stream_init(); prim_timer_init(); + prim_https_init(); prim_env_init(); prim_cwd_init(); prim_chdir_init(); diff --git a/docs/hvm/core.md b/docs/hvm/core.md index ee89a46d..4bd616d4 100644 --- a/docs/hvm/core.md +++ b/docs/hvm/core.md @@ -59,4 +59,7 @@ Oper ::= "+" | "-" | "*" | "/" | "%" | "&&" | "||" `#Pend`, and `#Rdy` under `#OK{...}`, or `#ERR{String}`; stream primitives (`%stream_stdin_open`, `%stream_file_open`, `%stream_poll`, `%stream_wait`, `%stream_close`) use `#Strm`, `#Pend`, `#Rdy`, `#Byt`, and `#Eof` under - `#OK{...}`, or `#ERR{String}` (`%stream_close` returns `#OK{#Nil}`). + `#OK{...}`, or `#ERR{String}` (`%stream_close` returns `#OK{#Nil}`); https + primitives (`%https_get`, `%https_poll`, `%https_wait`, `%https_cancel`) use + `#Http`, `#Pend`, and `#Rdy` under `#OK{...}`, with outcomes `#Resp{status,#Nil,body}`, + `#Fail{code,msg}`, or `#Canceled`, or return `#ERR{String}`. diff --git a/docs/hvm/syntax.md b/docs/hvm/syntax.md index 0309705c..8e7876f9 100644 --- a/docs/hvm/syntax.md +++ b/docs/hvm/syntax.md @@ -243,6 +243,10 @@ can be written as `_ : d` or as a bare `d`. - `%timer_start(ms)` returns `#OK{#Time{id,seq}}` or `#ERR{String}`. - `%timer_poll(time)` returns `#OK{#Pend{time2}|#Rdy{time2}}` or `#ERR{String}`. - `%timer_wait(time)` returns `#OK{#Rdy{time2}}` or `#ERR{String}`. +- `%https_get(url)` returns `#OK{#Http{id,seq}}` or `#ERR{String}`. +- `%https_poll(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,#Nil,body}|#Fail{code,msg}|#Canceled}}` or `#ERR{String}`. +- `%https_wait(http)` returns `#OK{#Rdy{http2,#Resp{status,#Nil,body}|#Fail{code,msg}|#Canceled}}` or `#ERR{String}`. +- `%https_cancel(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,#Nil,body}|#Fail{code,msg}|#Canceled}}` or `#ERR{String}`. ## Priority wrapper and wildcard diff --git a/test/prim_https_cancel_bad_handle.hvm4 b/test/prim_https_cancel_bad_handle.hvm4 new file mode 100644 index 00000000..0f59854c --- /dev/null +++ b/test/prim_https_cancel_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %https_cancel(#Http{0,0}) +//EXPECT_CONTAINS:ERROR(https_cancel): E2 diff --git a/test/prim_https_get_bad_arg.hvm4 b/test/prim_https_get_bad_arg.hvm4 new file mode 100644 index 00000000..76b78149 --- /dev/null +++ b/test/prim_https_get_bad_arg.hvm4 @@ -0,0 +1,2 @@ +@main = %https_get(0) +//EXPECT_CONTAINS:ERROR(https_get): invalid `url` diff --git a/test/prim_https_poll_bad_handle.hvm4 b/test/prim_https_poll_bad_handle.hvm4 new file mode 100644 index 00000000..af6ca2ec --- /dev/null +++ b/test/prim_https_poll_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %https_poll(#Http{0,0}) +//EXPECT_CONTAINS:ERROR(https_poll): E2 diff --git a/test/prim_https_wait_era.hvm4 b/test/prim_https_wait_era.hvm4 new file mode 100644 index 00000000..5ac6a314 --- /dev/null +++ b/test/prim_https_wait_era.hvm4 @@ -0,0 +1,2 @@ +@main = %https_wait(&{}) +//!&{} From b6fe81d656addc9dafcaed0de2e4de6450a85dd5 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Wed, 11 Feb 2026 07:39:28 -0300 Subject: [PATCH 23/35] http prims --- clang/prim/fn/http/_.c | 1512 ++++++++++++++++++++++++++++++++++ clang/prim/fn/http/cancel.c | 141 ++++ clang/prim/fn/http/poll.c | 131 +++ clang/prim/fn/http/request.c | 152 ++++ clang/prim/fn/http/wait.c | 127 +++ clang/prim/fn/https/_.c | 548 ------------ clang/prim/fn/https/cancel.c | 137 --- clang/prim/fn/https/get.c | 209 ----- clang/prim/fn/https/poll.c | 127 --- clang/prim/fn/https/wait.c | 123 --- 10 files changed, 2063 insertions(+), 1144 deletions(-) create mode 100644 clang/prim/fn/http/_.c create mode 100644 clang/prim/fn/http/cancel.c create mode 100644 clang/prim/fn/http/poll.c create mode 100644 clang/prim/fn/http/request.c create mode 100644 clang/prim/fn/http/wait.c delete mode 100644 clang/prim/fn/https/_.c delete mode 100644 clang/prim/fn/https/cancel.c delete mode 100644 clang/prim/fn/https/get.c delete mode 100644 clang/prim/fn/https/poll.c delete mode 100644 clang/prim/fn/https/wait.c diff --git a/clang/prim/fn/http/_.c b/clang/prim/fn/http/_.c new file mode 100644 index 00000000..e1ac9b6c --- /dev/null +++ b/clang/prim/fn/http/_.c @@ -0,0 +1,1512 @@ +#include +#include +#include +#include + +#define HTTP_CAP (1u << 18) +#define HTTP_ARG_CAP 512 +#define HTTP_STR_CAP 8192 +#define HTTP_HEADER_CAP 4096 +#define HTTP_REASON_MSG_CAP 1024 +#define HTTP_BODY_HARD_CAP (1u << 24) +#define HTTP_DEFAULT_BODY_CAP (1u << 20) + +#define HTTP_ERR_BAD_ARG 1 +#define HTTP_ERR_BAD_HANDLE 2 +#define HTTP_ERR_STALE 3 +#define HTTP_ERR_FULL 4 +#define HTTP_ERR_IO 5 + +typedef struct { + char method[16]; + char url[HTTP_STR_CAP]; + char **headers; + u32 headers_len; + u32 headers_cap; + u8 body_kind; + char *body_text; + u8 *body_bytes; + u32 body_size; + u32 body_cap; + u32 timeout_ms; + u32 connect_timeout_ms; + u8 follow_redirects; + u32 max_redirects; + u8 verify_tls; + u32 max_body_bytes; +} HttpReq; + +typedef struct { + u32 expected_seq; + pid_t pid; + u8 finished; + u8 canceled; + u8 signaled; + u8 parsed; + u32 code; + u32 max_body_bytes; + Term outcome; + + char *tmp_dir; + char *hdr_path; + char *body_path; + char *meta_path; + char *err_path; + char *req_path; +} HttpSlot; + +typedef struct { + char *name; + char *value; +} HttpHdrPair; + +static HttpSlot HTTP_SLOTS[HTTP_CAP]; +static u32 HTTP_NEXT_ID = 1; +static pthread_mutex_t HTTP_LOCK = PTHREAD_MUTEX_INITIALIZER; + +// Core async/result constructors +static u32 HTTP_NAM_HTTP = 0; +static u32 HTTP_NAM_PEND = 0; +static u32 HTTP_NAM_RDY = 0; +static u32 HTTP_NAM_RESP = 0; +static u32 HTTP_NAM_HDR = 0; +static u32 HTTP_NAM_FAIL = 0; +static u32 HTTP_NAM_CANCELED = 0; + +// Fail reason constructors +static u32 HTTP_NAM_TIMEOUT = 0; +static u32 HTTP_NAM_DNS = 0; +static u32 HTTP_NAM_CONNECT = 0; +static u32 HTTP_NAM_TLS = 0; +static u32 HTTP_NAM_PROTOCOL = 0; +static u32 HTTP_NAM_CURL_EXIT = 0; +static u32 HTTP_NAM_CURL_SIGNAL = 0; +static u32 HTTP_NAM_PARSE = 0; +static u32 HTTP_NAM_BODY_TOO_LARGE = 0; +static u32 HTTP_NAM_IO = 0; + +// Request constructors +static u32 HTTP_NAM_REQ = 0; +static u32 HTTP_NAM_GET = 0; +static u32 HTTP_NAM_POST = 0; +static u32 HTTP_NAM_PUT = 0; +static u32 HTTP_NAM_PATCH = 0; +static u32 HTTP_NAM_DELETE = 0; +static u32 HTTP_NAM_HEAD = 0; +static u32 HTTP_NAM_OPTIONS = 0; +static u32 HTTP_NAM_NOBODY = 0; +static u32 HTTP_NAM_BODY_TEXT = 0; +static u32 HTTP_NAM_BODY_BYTES = 0; +static u32 HTTP_NAM_OPTS = 0; +static u32 HTTP_NAM_T = 0; +static u32 HTTP_NAM_F = 0; + +#define HTTP_BODY_NONE 0 +#define HTTP_BODY_TEXT 1 +#define HTTP_BODY_BYTES 2 + +fn Term wnf(Term term); + +fn Term http_new_err(const char *prim, u32 code, const char *msg) { + Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); + return term_new_ctr(NAM_ERR, 1, &txt); +} + +fn Term http_new_ok(Term val) { + return term_new_ctr(NAM_OK, 1, &val); +} + +fn Term http_new_http(u32 id, u32 seq) { + Term args[2] = {term_new_num(id), term_new_num(seq)}; + return term_new_ctr(HTTP_NAM_HTTP, 2, args); +} + +fn Term http_new_pend(u32 id, u32 seq) { + Term http = http_new_http(id, seq); + return term_new_ctr(HTTP_NAM_PEND, 1, &http); +} + +fn Term http_new_rdy(u32 id, u32 seq, Term outcome) { + Term http = http_new_http(id, seq); + Term args[2] = {http, outcome}; + return term_new_ctr(HTTP_NAM_RDY, 2, args); +} + +fn Term http_new_reason0(u32 nam) { + return term_new_ctr(nam, 0, NULL); +} + +fn Term http_new_reason1(u32 nam, u32 val) { + Term arg = term_new_num(val); + return term_new_ctr(nam, 1, &arg); +} + +fn Term http_new_fail(Term reason, Term msg) { + Term args[2] = {reason, msg}; + return term_new_ctr(HTTP_NAM_FAIL, 2, args); +} + +fn Term http_new_canceled(void) { + return term_new_ctr(HTTP_NAM_CANCELED, 0, NULL); +} + +fn Term http_new_hdr(Term name, Term value) { + Term args[2] = {name, value}; + return term_new_ctr(HTTP_NAM_HDR, 2, args); +} + +fn Term http_new_resp(u32 status, Term headers, Term body) { + Term args[3] = {term_new_num(status), headers, body}; + return term_new_ctr(HTTP_NAM_RESP, 3, args); +} + +fn u8 http_parse_num(Term term, u32 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case NUM: { + *out = term_val(val); + return 1; + } + default: { + return 0; + } + } +} + +fn u8 http_parse_bool(Term term, u8 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C00: { + u32 ext = term_ext(val); + if (ext == HTTP_NAM_T) { + *out = 1; + return 1; + } + if (ext == HTTP_NAM_F) { + *out = 0; + return 1; + } + return 0; + } + default: { + return 0; + } + } +} + +fn u8 http_parse_handle(Term term, u32 *id, u32 *seq) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C02: { + if (term_ext(val) != HTTP_NAM_HTTP) { + return 0; + } + + u32 loc = term_val(val); + Term id_tm = heap_read(loc + 0); + Term seq_tm = heap_read(loc + 1); + + if (!http_parse_num(id_tm, id)) { + return 0; + } + if (!http_parse_num(seq_tm, seq)) { + return 0; + } + return 1; + } + default: { + return 0; + } + } +} + +fn u8 http_is_valid_id(u32 id) { + pthread_mutex_lock(&HTTP_LOCK); + + if (id == 0 || id >= HTTP_NEXT_ID || id >= HTTP_CAP) { + pthread_mutex_unlock(&HTTP_LOCK); + return 0; + } + + pthread_mutex_unlock(&HTTP_LOCK); + return 1; +} + +fn void http_set_finished(u32 id, u8 signaled, u32 code) { + pthread_mutex_lock(&HTTP_LOCK); + + if (id != 0 && id < HTTP_NEXT_ID && id < HTTP_CAP) { + HttpSlot *slot = &HTTP_SLOTS[id]; + slot->finished = 1; + slot->signaled = signaled; + slot->code = code; + } + + pthread_mutex_unlock(&HTTP_LOCK); +} + +fn void http_set_canceled(u32 id) { + pthread_mutex_lock(&HTTP_LOCK); + + if (id != 0 && id < HTTP_NEXT_ID && id < HTTP_CAP) { + HTTP_SLOTS[id].canceled = 1; + } + + pthread_mutex_unlock(&HTTP_LOCK); +} + +fn void http_status_from_wait(int status, u8 *signaled, u32 *code) { + if (WIFEXITED(status)) { + *signaled = 0; + *code = (u32)WEXITSTATUS(status); + return; + } + + if (WIFSIGNALED(status)) { + *signaled = 1; + *code = (u32)WTERMSIG(status); + return; + } + + *signaled = 0; + *code = 255; +} + +fn char *http_strdup(const char *str) { + size_t len = strlen(str); + char *out = malloc(len + 1); + if (!out) { + return NULL; + } + + memcpy(out, str, len); + out[len] = '\0'; + return out; +} + +fn char *http_join_path(const char *dir, const char *name) { + size_t dlen = strlen(dir); + size_t nlen = strlen(name); + char *out = malloc(dlen + 1 + nlen + 1); + if (!out) { + return NULL; + } + + memcpy(out, dir, dlen); + out[dlen] = '/'; + memcpy(out + dlen + 1, name, nlen); + out[dlen + 1 + nlen] = '\0'; + return out; +} + +fn void http_paths_free( + char **tmp_dir, + char **hdr_path, + char **body_path, + char **meta_path, + char **err_path, + char **req_path +) { + if (*hdr_path) { + unlink(*hdr_path); + free(*hdr_path); + *hdr_path = NULL; + } + if (*body_path) { + unlink(*body_path); + free(*body_path); + *body_path = NULL; + } + if (*meta_path) { + unlink(*meta_path); + free(*meta_path); + *meta_path = NULL; + } + if (*err_path) { + unlink(*err_path); + free(*err_path); + *err_path = NULL; + } + if (*req_path) { + unlink(*req_path); + free(*req_path); + *req_path = NULL; + } + if (*tmp_dir) { + rmdir(*tmp_dir); + free(*tmp_dir); + *tmp_dir = NULL; + } +} + +fn void http_slot_cleanup(HttpSlot *slot) { + http_paths_free( + &slot->tmp_dir, + &slot->hdr_path, + &slot->body_path, + &slot->meta_path, + &slot->err_path, + &slot->req_path + ); +} + +fn u8 http_make_paths( + char **tmp_dir, + char **hdr_path, + char **body_path, + char **meta_path, + char **err_path, + char **req_path +) { + char tmpl[] = "/tmp/hvm4_http_XXXXXX"; + char *dir = http_strdup(tmpl); + if (!dir) { + return 0; + } + + if (!mkdtemp(dir)) { + free(dir); + return 0; + } + + char *hdr = http_join_path(dir, "headers.txt"); + char *bod = http_join_path(dir, "body.bin"); + char *met = http_join_path(dir, "meta.txt"); + char *err = http_join_path(dir, "err.txt"); + char *req = http_join_path(dir, "request.bin"); + if (!hdr || !bod || !met || !err || !req) { + http_paths_free(&dir, &hdr, &bod, &met, &err, &req); + return 0; + } + + *tmp_dir = dir; + *hdr_path = hdr; + *body_path = bod; + *meta_path = met; + *err_path = err; + *req_path = req; + return 1; +} + +fn u8 http_read_status_code(const char *meta_path, u32 *status) { + FILE *f = fopen(meta_path, "rb"); + if (!f) { + return 0; + } + + char buf[64]; + size_t got = fread(buf, 1, sizeof(buf) - 1, f); + fclose(f); + buf[got] = '\0'; + + char *p = buf; + while (*p && !isdigit((unsigned char)*p)) { + p++; + } + + if (!*p) { + return 0; + } + + long code = strtol(p, NULL, 10); + if (code < 0 || code > 9999) { + return 0; + } + + *status = (u32)code; + return 1; +} + +fn Term http_read_stderr_msg(const char *err_path, const char *fallback) { + FILE *f = fopen(err_path, "rb"); + if (!f) { + return term_string_from_utf8(fallback); + } + + char buf[HTTP_REASON_MSG_CAP]; + size_t got = fread(buf, 1, sizeof(buf) - 1, f); + fclose(f); + + while (got > 0 && (buf[got - 1] == '\n' || buf[got - 1] == '\r')) { + got--; + } + buf[got] = '\0'; + + if (got == 0) { + return term_string_from_utf8(fallback); + } + + return term_string_from_utf8(buf); +} + +fn u8 http_req_init(HttpReq *req) { + req->method[0] = '\0'; + req->url[0] = '\0'; + req->headers = NULL; + req->headers_len = 0; + req->headers_cap = 0; + req->body_kind = HTTP_BODY_NONE; + req->body_text = NULL; + req->body_bytes = NULL; + req->body_size = 0; + req->body_cap = 0; + req->timeout_ms = 0; + req->connect_timeout_ms = 0; + req->follow_redirects = 0; + req->max_redirects = 0; + req->verify_tls = 1; + req->max_body_bytes = HTTP_DEFAULT_BODY_CAP; + return 1; +} + +fn void http_req_free(HttpReq *req) { + if (req->headers) { + for (u32 i = 0; i < req->headers_len; ++i) { + free(req->headers[i]); + } + free(req->headers); + req->headers = NULL; + } + + if (req->body_text) { + free(req->body_text); + req->body_text = NULL; + } + + if (req->body_bytes) { + free(req->body_bytes); + req->body_bytes = NULL; + } + + req->headers_len = 0; + req->headers_cap = 0; + req->body_size = 0; + req->body_cap = 0; +} + +fn u8 http_req_push_header(HttpReq *req, char *line) { + if (req->headers_len == req->headers_cap) { + u32 next_cap = req->headers_cap == 0 ? 8 : req->headers_cap * 2; + char **next = realloc(req->headers, (size_t)next_cap * sizeof(char *)); + if (!next) { + return 0; + } + req->headers = next; + req->headers_cap = next_cap; + } + + req->headers[req->headers_len] = line; + req->headers_len = req->headers_len + 1; + return 1; +} + +fn u8 http_req_push_body_byte(HttpReq *req, u8 byte) { + u32 len = req->body_size; + + if (len >= HTTP_BODY_HARD_CAP) { + return 0; + } + + if (len == req->body_cap) { + u32 next_cap = req->body_cap == 0 ? 256 : req->body_cap * 2; + if (next_cap > HTTP_BODY_HARD_CAP) { + next_cap = HTTP_BODY_HARD_CAP; + } + if (next_cap == req->body_cap) { + return 0; + } + + u8 *next = realloc(req->body_bytes, (size_t)next_cap); + if (!next) { + return 0; + } + req->body_bytes = next; + req->body_cap = next_cap; + } + + req->body_bytes[len] = byte; + req->body_size = len + 1; + return 1; +} + +fn u8 http_parse_method(Term term, char out[16]) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C00: { + u32 ext = term_ext(val); + if (ext == HTTP_NAM_GET) { + strcpy(out, "GET"); + return 1; + } + if (ext == HTTP_NAM_POST) { + strcpy(out, "POST"); + return 1; + } + if (ext == HTTP_NAM_PUT) { + strcpy(out, "PUT"); + return 1; + } + if (ext == HTTP_NAM_PATCH) { + strcpy(out, "PATCH"); + return 1; + } + if (ext == HTTP_NAM_DELETE) { + strcpy(out, "DELETE"); + return 1; + } + if (ext == HTTP_NAM_HEAD) { + strcpy(out, "HEAD"); + return 1; + } + if (ext == HTTP_NAM_OPTIONS) { + strcpy(out, "OPTIONS"); + return 1; + } + return 0; + } + default: { + return 0; + } + } +} + +fn u8 http_parse_header_item(Term term, HttpReq *req, Term *err_out) { + Term val = wnf(term); + + if (term_tag(val) != C02 || term_ext(val) != HTTP_NAM_HDR) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `headers`; expected List<#Hdr{name,value}>"); + return 0; + } + + u32 loc = term_val(val); + Term name_tm = heap_read(loc + 0); + Term value_tm = heap_read(loc + 1); + + char name[HTTP_HEADER_CAP]; + char value[HTTP_HEADER_CAP]; + + HStrErr name_err; + if (!term_string_to_utf8_cstr(name_tm, name, HTTP_HEADER_CAP, NULL, &name_err)) { + *err_out = term_string_from_hstrerr("http_request", "header_name", HTTP_HEADER_CAP, name_err); + return 0; + } + + HStrErr value_err; + if (!term_string_to_utf8_cstr(value_tm, value, HTTP_HEADER_CAP, NULL, &value_err)) { + *err_out = term_string_from_hstrerr("http_request", "header_value", HTTP_HEADER_CAP, value_err); + return 0; + } + + size_t nlen = strlen(name); + size_t vlen = strlen(value); + char *line = malloc(nlen + 2 + vlen + 1); + if (!line) { + *err_out = http_new_err("http_request", HTTP_ERR_IO, "out of memory while building headers"); + return 0; + } + + memcpy(line, name, nlen); + line[nlen + 0] = ':'; + line[nlen + 1] = ' '; + memcpy(line + nlen + 2, value, vlen); + line[nlen + 2 + vlen] = '\0'; + + if (!http_req_push_header(req, line)) { + free(line); + *err_out = http_new_err("http_request", HTTP_ERR_IO, "out of memory while storing headers"); + return 0; + } + + return 1; +} + +fn u8 http_parse_headers(Term term, HttpReq *req, Term *err_out) { + Term cur = wnf(term); + + while (term_tag(cur) == C02 && term_ext(cur) == NAM_CON) { + u32 loc = term_val(cur); + Term head = heap_read(loc + 0); + Term tail = heap_read(loc + 1); + + if (!http_parse_header_item(head, req, err_out)) { + return 0; + } + + cur = wnf(tail); + } + + if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `headers`; expected List<#Hdr{name,value}>"); + return 0; + } + + return 1; +} + +fn u8 http_parse_body_bytes_list(Term term, HttpReq *req, Term *err_out) { + Term cur = wnf(term); + + while (term_tag(cur) == C02 && term_ext(cur) == NAM_CON) { + u32 loc = term_val(cur); + Term head = wnf(heap_read(loc + 0)); + Term tail = heap_read(loc + 1); + + if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#Byt{n}>"); + return 0; + } + + Term num = wnf(heap_read(term_val(head))); + if (term_tag(num) != NUM) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected #Byt{NUM}"); + return 0; + } + + u32 val = term_val(num); + if (val > 255) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; byte must be in [0,255]"); + return 0; + } + + if (!http_req_push_body_byte(req, (u8)val)) { + *err_out = http_new_err("http_request", HTTP_ERR_IO, "out of memory while decoding body bytes"); + return 0; + } + + cur = wnf(tail); + } + + if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#Byt{n}>"); + return 0; + } + + return 1; +} + +fn u8 http_parse_body(Term term, HttpReq *req, Term *err_out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C00: { + if (term_ext(val) != HTTP_NAM_NOBODY) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected #NoBody|#BodyText|#BodyBytes"); + return 0; + } + req->body_kind = HTTP_BODY_NONE; + return 1; + } + case C01: { + u32 ext = term_ext(val); + u32 loc = term_val(val); + + if (ext == HTTP_NAM_BODY_TEXT) { + char *text = malloc(HTTP_BODY_HARD_CAP); + if (!text) { + *err_out = http_new_err("http_request", HTTP_ERR_IO, "out of memory while decoding body text"); + return 0; + } + + HStrErr text_err; + if (!term_string_to_utf8_cstr(heap_read(loc), text, HTTP_BODY_HARD_CAP, NULL, &text_err)) { + free(text); + *err_out = term_string_from_hstrerr("http_request", "body_text", HTTP_BODY_HARD_CAP, text_err); + return 0; + } + + req->body_text = text; + + req->body_kind = HTTP_BODY_TEXT; + req->body_size = (u32)strlen(req->body_text); + return 1; + } + + if (ext == HTTP_NAM_BODY_BYTES) { + if (!http_parse_body_bytes_list(heap_read(loc), req, err_out)) { + return 0; + } + req->body_kind = HTTP_BODY_BYTES; + return 1; + } + + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected #NoBody|#BodyText|#BodyBytes"); + return 0; + } + default: { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected #NoBody|#BodyText|#BodyBytes"); + return 0; + } + } +} + +fn u8 http_parse_opts(Term term, HttpReq *req, Term *err_out) { + Term val = wnf(term); + + if (term_tag(val) != C06 || term_ext(val) != HTTP_NAM_OPTS) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts`; expected #Opts{timeout_ms,connect_timeout_ms,follow_redirects,max_redirects,verify_tls,max_body_bytes}"); + return 0; + } + + u32 loc = term_val(val); + + if (!http_parse_num(heap_read(loc + 0), &req->timeout_ms)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.timeout_ms`; expected NUM"); + return 0; + } + if (!http_parse_num(heap_read(loc + 1), &req->connect_timeout_ms)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.connect_timeout_ms`; expected NUM"); + return 0; + } + if (!http_parse_bool(heap_read(loc + 2), &req->follow_redirects)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.follow_redirects`; expected #T{}|#F{}"); + return 0; + } + if (!http_parse_num(heap_read(loc + 3), &req->max_redirects)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.max_redirects`; expected NUM"); + return 0; + } + if (!http_parse_bool(heap_read(loc + 4), &req->verify_tls)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.verify_tls`; expected #T{}|#F{}"); + return 0; + } + if (!http_parse_num(heap_read(loc + 5), &req->max_body_bytes)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.max_body_bytes`; expected NUM"); + return 0; + } + + if (req->max_body_bytes == 0 || req->max_body_bytes > HTTP_BODY_HARD_CAP) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `opts.max_body_bytes`; must be in [1,HTTP_BODY_HARD_CAP]"); + return 0; + } + + return 1; +} + +fn u8 http_parse_request(Term req_tm, HttpReq *req, Term *err_out) { + Term val = wnf(req_tm); + + if (term_tag(val) != C05 || term_ext(val) != HTTP_NAM_REQ) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `req`; expected #Req{method,url,headers,body,opts}"); + return 0; + } + + u32 loc = term_val(val); + Term method = heap_read(loc + 0); + Term url = heap_read(loc + 1); + Term headers = heap_read(loc + 2); + Term body = heap_read(loc + 3); + Term opts = heap_read(loc + 4); + + if (!http_parse_method(method, req->method)) { + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `req.method`; expected #Get|#Post|#Put|#Patch|#Delete|#Head|#Options"); + return 0; + } + + HStrErr url_err; + if (!term_string_to_utf8_cstr(url, req->url, HTTP_STR_CAP, NULL, &url_err)) { + *err_out = term_string_from_hstrerr("http_request", "url", HTTP_STR_CAP, url_err); + return 0; + } + + if (!http_parse_headers(headers, req, err_out)) { + return 0; + } + + if (!http_parse_body(body, req, err_out)) { + return 0; + } + + if (!http_parse_opts(opts, req, err_out)) { + return 0; + } + + return 1; +} + +fn u8 http_write_all(int fd, const u8 *buf, u32 len) { + u32 off = 0; + while (off < len) { + ssize_t wrote = write(fd, buf + off, (size_t)(len - off)); + if (wrote > 0) { + off = off + (u32)wrote; + continue; + } + if (wrote < 0 && errno == EINTR) { + continue; + } + return 0; + } + + return 1; +} + +fn u8 http_write_body_file(const char *path, const HttpReq *req) { + if (req->body_kind != HTTP_BODY_BYTES) { + return 1; + } + + int fd = open(path, O_WRONLY | O_CREAT | O_TRUNC, 0600); + if (fd < 0) { + return 0; + } + + u8 ok = http_write_all(fd, req->body_bytes, req->body_size); + int close_ret = close(fd); + if (!ok || close_ret < 0) { + return 0; + } + + return 1; +} + +fn int http_open_trunc_file(const char *path) { + while (1) { + int fd = open(path, O_WRONLY | O_CREAT | O_TRUNC, 0600); + if (fd >= 0) { + return fd; + } + if (errno == EINTR) { + continue; + } + return -1; + } +} + +fn int http_dup2_retry(int old_fd, int new_fd) { + while (1) { + if (dup2(old_fd, new_fd) >= 0) { + return 1; + } + if (errno == EINTR) { + continue; + } + return 0; + } +} + +fn u8 http_argv_push(char **argv, u32 *argc, char *arg) { + if (*argc >= HTTP_ARG_CAP - 1) { + return 0; + } + + argv[*argc] = arg; + *argc = *argc + 1; + return 1; +} + +fn void http_child_exec_request( + const HttpReq *req, + const char *hdr_path, + const char *body_path, + const char *meta_path, + const char *err_path, + const char *req_path +) { + int meta_fd = http_open_trunc_file(meta_path); + if (meta_fd < 0) { + _exit(127); + } + + int err_fd = http_open_trunc_file(err_path); + if (err_fd < 0) { + close(meta_fd); + _exit(127); + } + + if (!http_dup2_retry(meta_fd, STDOUT_FILENO)) { + close(meta_fd); + close(err_fd); + _exit(127); + } + + if (!http_dup2_retry(err_fd, STDERR_FILENO)) { + close(meta_fd); + close(err_fd); + _exit(127); + } + + close(meta_fd); + close(err_fd); + + char timeout_arg[64]; + char connect_timeout_arg[64]; + char max_redirs_arg[32]; + char data_path_arg[HTTP_STR_CAP + 16]; + + snprintf(timeout_arg, sizeof(timeout_arg), "%.3f", (double)req->timeout_ms / 1000.0); + snprintf(connect_timeout_arg, sizeof(connect_timeout_arg), "%.3f", (double)req->connect_timeout_ms / 1000.0); + snprintf(max_redirs_arg, sizeof(max_redirs_arg), "%u", req->max_redirects); + snprintf(data_path_arg, sizeof(data_path_arg), "@%s", req_path); + + char *argv[HTTP_ARG_CAP]; + u32 argc = 0; + + if (!http_argv_push(argv, &argc, "curl")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "-sS")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "-X")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, (char *)req->method)) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "-D")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, (char *)hdr_path)) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "-o")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, (char *)body_path)) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "-w")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "%{http_code}\n")) { + _exit(127); + } + + if (req->timeout_ms > 0) { + if (!http_argv_push(argv, &argc, "--max-time")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, timeout_arg)) { + _exit(127); + } + } + + if (req->connect_timeout_ms > 0) { + if (!http_argv_push(argv, &argc, "--connect-timeout")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, connect_timeout_arg)) { + _exit(127); + } + } + + if (req->follow_redirects) { + if (!http_argv_push(argv, &argc, "-L")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, "--max-redirs")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, max_redirs_arg)) { + _exit(127); + } + } + + if (!req->verify_tls) { + if (!http_argv_push(argv, &argc, "-k")) { + _exit(127); + } + } + + for (u32 i = 0; i < req->headers_len; ++i) { + if (!http_argv_push(argv, &argc, "-H")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, req->headers[i])) { + _exit(127); + } + } + + if (req->body_kind == HTTP_BODY_TEXT) { + if (!http_argv_push(argv, &argc, "--data-binary")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, req->body_text)) { + _exit(127); + } + } + + if (req->body_kind == HTTP_BODY_BYTES) { + if (!http_argv_push(argv, &argc, "--data-binary")) { + _exit(127); + } + if (!http_argv_push(argv, &argc, data_path_arg)) { + _exit(127); + } + } + + if (!http_argv_push(argv, &argc, (char *)req->url)) { + _exit(127); + } + + argv[argc] = NULL; + execvp("curl", argv); + _exit(127); +} + +fn Term http_reason_from_curl_exit(u32 code) { + switch (code) { + case 6: { + return http_new_reason0(HTTP_NAM_DNS); + } + case 7: { + return http_new_reason0(HTTP_NAM_CONNECT); + } + case 28: { + return http_new_reason0(HTTP_NAM_TIMEOUT); + } + + case 35: + case 51: + case 53: + case 54: + case 58: + case 59: + case 60: + case 64: + case 66: + case 77: + case 80: + case 82: + case 83: + case 90: + case 91: + case 95: + case 96: { + return http_new_reason0(HTTP_NAM_TLS); + } + + case 1: + case 3: + case 4: + case 5: + case 8: + case 9: + case 16: + case 22: + case 47: + case 52: + case 56: { + return http_new_reason0(HTTP_NAM_PROTOCOL); + } + + default: { + return http_new_reason1(HTTP_NAM_CURL_EXIT, code); + } + } +} + +fn int http_read_header_pairs(const char *hdr_path, HttpHdrPair **pairs_out, u32 *len_out, int *io_err_out) { + FILE *f = fopen(hdr_path, "rb"); + if (!f) { + *io_err_out = errno; + return 0; + } + + HttpHdrPair *pairs = NULL; + u32 len = 0; + u32 cap = 0; + char *line = NULL; + size_t line_cap = 0; + + while (1) { + ssize_t got = getline(&line, &line_cap, f); + if (got < 0) { + break; + } + + while (got > 0 && (line[got - 1] == '\n' || line[got - 1] == '\r')) { + line[got - 1] = '\0'; + got--; + } + + if (got == 0) { + continue; + } + + if (strncmp(line, "HTTP/", 5) == 0) { + for (u32 i = 0; i < len; ++i) { + free(pairs[i].name); + free(pairs[i].value); + } + len = 0; + continue; + } + + char *colon = strchr(line, ':'); + if (!colon) { + continue; + } + + *colon = '\0'; + char *name = line; + char *value = colon + 1; + + while (*value == ' ' || *value == '\t') { + value++; + } + + if (*name == '\0') { + continue; + } + + char *name_copy = http_strdup(name); + char *value_copy = http_strdup(value); + if (!name_copy || !value_copy) { + free(name_copy); + free(value_copy); + free(line); + for (u32 i = 0; i < len; ++i) { + free(pairs[i].name); + free(pairs[i].value); + } + free(pairs); + fclose(f); + *io_err_out = ENOMEM; + return 0; + } + + if (len == cap) { + u32 next_cap = cap == 0 ? 8 : cap * 2; + HttpHdrPair *next = realloc(pairs, (size_t)next_cap * sizeof(HttpHdrPair)); + if (!next) { + free(name_copy); + free(value_copy); + free(line); + for (u32 i = 0; i < len; ++i) { + free(pairs[i].name); + free(pairs[i].value); + } + free(pairs); + fclose(f); + *io_err_out = ENOMEM; + return 0; + } + pairs = next; + cap = next_cap; + } + + pairs[len].name = name_copy; + pairs[len].value = value_copy; + len = len + 1; + } + + free(line); + + if (ferror(f)) { + int err = errno; + for (u32 i = 0; i < len; ++i) { + free(pairs[i].name); + free(pairs[i].value); + } + free(pairs); + fclose(f); + *io_err_out = err; + return 0; + } + + fclose(f); + *pairs_out = pairs; + *len_out = len; + return 1; +} + +fn Term http_pairs_to_term(HttpHdrPair *pairs, u32 len) { + Term out = term_new_ctr(NAM_NIL, 0, NULL); + + for (u32 i = len; i > 0; --i) { + Term name = term_string_from_utf8(pairs[i - 1].name); + Term val = term_string_from_utf8(pairs[i - 1].value); + Term hdr = http_new_hdr(name, val); + Term args[2] = {hdr, out}; + out = term_new_ctr(NAM_CON, 2, args); + } + + return out; +} + +fn int http_read_body_bytes(const char *body_path, u32 cap, Term *body_out, int *io_err_out) { + FILE *f = fopen(body_path, "rb"); + if (!f) { + *io_err_out = errno; + return -1; + } + + Term nil = term_new_ctr(NAM_NIL, 0, NULL); + u8 byte = 0; + int first = fgetc(f); + if (first == EOF) { + if (ferror(f)) { + int err = errno; + fclose(f); + *io_err_out = err; + return -1; + } + fclose(f); + *body_out = nil; + return 1; + } + + byte = (u8)first; + u32 count = 1; + + Term byt_num[1] = {term_new_num(byte)}; + Term node[2] = {term_new_ctr(NAM_BYT, 1, byt_num), nil}; + Term out = term_new_ctr(NAM_CON, 2, node); + Term curr = out; + + while (1) { + int got = fgetc(f); + if (got == EOF) { + break; + } + + count = count + 1; + if (count > cap) { + fclose(f); + return 0; + } + + byt_num[0] = term_new_num((u8)got); + node[0] = term_new_ctr(NAM_BYT, 1, byt_num); + heap_set(term_val(curr) + 1, term_new_ctr(NAM_CON, 2, node)); + curr = heap_read(term_val(curr) + 1); + } + + if (ferror(f)) { + int err = errno; + fclose(f); + *io_err_out = err; + return -1; + } + + fclose(f); + *body_out = out; + return 1; +} + +fn Term http_build_outcome( + u8 canceled, + u8 signaled, + u32 code, + u32 max_body_bytes, + const char *hdr_path, + const char *meta_path, + const char *body_path, + const char *err_path +) { + if (canceled) { + return http_new_canceled(); + } + + if (signaled) { + Term rsn = http_new_reason1(HTTP_NAM_CURL_SIGNAL, code); + Term msg = term_string_printf("curl terminated by signal %u", code); + return http_new_fail(rsn, msg); + } + + if (code != 0) { + Term rsn = http_reason_from_curl_exit(code); + Term msg = http_read_stderr_msg(err_path, "curl request failed"); + return http_new_fail(rsn, msg); + } + + u32 status = 0; + if (!http_read_status_code(meta_path, &status)) { + Term rsn = http_new_reason0(HTTP_NAM_PARSE); + Term msg = term_string_printf("failed to parse HTTP status from '%s'", meta_path); + return http_new_fail(rsn, msg); + } + + HttpHdrPair *pairs = NULL; + u32 pair_n = 0; + int hdr_io_err = 0; + if (!http_read_header_pairs(hdr_path, &pairs, &pair_n, &hdr_io_err)) { + Term rsn = http_new_reason1(HTTP_NAM_IO, (u32)hdr_io_err); + Term msg = term_string_printf( + "failed to read response headers '%s': %s (errno=%d)", + hdr_path, + strerror(hdr_io_err), + hdr_io_err + ); + return http_new_fail(rsn, msg); + } + + Term headers = http_pairs_to_term(pairs, pair_n); + + for (u32 i = 0; i < pair_n; ++i) { + free(pairs[i].name); + free(pairs[i].value); + } + free(pairs); + + Term body = term_new_era(); + int body_io_err = 0; + int body_ret = http_read_body_bytes(body_path, max_body_bytes, &body, &body_io_err); + if (body_ret == 0) { + Term rsn = http_new_reason1(HTTP_NAM_BODY_TOO_LARGE, max_body_bytes); + Term msg = term_string_printf("response body too large (limit=%u bytes)", max_body_bytes); + return http_new_fail(rsn, msg); + } + if (body_ret < 0) { + Term rsn = http_new_reason1(HTTP_NAM_IO, (u32)body_io_err); + Term msg = term_string_printf( + "failed to read response body '%s': %s (errno=%d)", + body_path, + strerror(body_io_err), + body_io_err + ); + return http_new_fail(rsn, msg); + } + + return http_new_resp(status, headers, body); +} + +fn void http_set_outcome(u32 id, Term outcome) { + pthread_mutex_lock(&HTTP_LOCK); + + if (id != 0 && id < HTTP_NEXT_ID && id < HTTP_CAP) { + HttpSlot *slot = &HTTP_SLOTS[id]; + slot->outcome = outcome; + slot->parsed = 1; + http_slot_cleanup(slot); + } + + pthread_mutex_unlock(&HTTP_LOCK); +} + +fn pid_t http_waitpid_retry(pid_t pid, int *status, int opts) { + while (1) { + pid_t got = waitpid(pid, status, opts); + if (got >= 0) { + return got; + } + if (errno == EINTR) { + continue; + } + return -1; + } +} + +fn Term http_parse_and_store_outcome( + u32 id, + u8 canceled, + u8 signaled, + u32 code, + u32 max_body_bytes, + const char *hdr_path, + const char *meta_path, + const char *body_path, + const char *err_path +) { + Term outcome = http_build_outcome( + canceled, + signaled, + code, + max_body_bytes, + hdr_path, + meta_path, + body_path, + err_path + ); + + http_set_outcome(id, outcome); + return outcome; +} + +fn u8 http_claim( + u32 id, + u32 seq, + pid_t *pid, + u8 *finished, + u8 *parsed, + u8 *canceled, + u8 *signaled, + u32 *code, + u32 *max_body_bytes, + Term *outcome, + char **hdr_path, + char **meta_path, + char **body_path, + char **err_path +) { + pthread_mutex_lock(&HTTP_LOCK); + + if (id == 0 || id >= HTTP_NEXT_ID || id >= HTTP_CAP) { + pthread_mutex_unlock(&HTTP_LOCK); + return 0; + } + + HttpSlot *slot = &HTTP_SLOTS[id]; + if (slot->expected_seq != seq) { + pthread_mutex_unlock(&HTTP_LOCK); + return 0; + } + + slot->expected_seq = seq + 1; + *pid = slot->pid; + *finished = slot->finished; + *parsed = slot->parsed; + *canceled = slot->canceled; + *signaled = slot->signaled; + *code = slot->code; + *max_body_bytes = slot->max_body_bytes; + *outcome = slot->outcome; + *hdr_path = slot->hdr_path; + *meta_path = slot->meta_path; + *body_path = slot->body_path; + *err_path = slot->err_path; + + pthread_mutex_unlock(&HTTP_LOCK); + return 1; +} + +#include "request.c" +#include "poll.c" +#include "wait.c" +#include "cancel.c" + +fn void prim_http_init(void) { + HTTP_NAM_HTTP = nick_from_str("Http", 4); + HTTP_NAM_PEND = nick_from_str("Pend", 4); + HTTP_NAM_RDY = nick_from_str("Rdy", 3); + HTTP_NAM_RESP = nick_from_str("Resp", 4); + HTTP_NAM_HDR = nick_from_str("Hdr", 3); + HTTP_NAM_FAIL = nick_from_str("Fail", 4); + HTTP_NAM_CANCELED = nick_from_str("Canceled", 8); + + HTTP_NAM_TIMEOUT = nick_from_str("Timeout", 7); + HTTP_NAM_DNS = nick_from_str("Dns", 3); + HTTP_NAM_CONNECT = nick_from_str("Connect", 7); + HTTP_NAM_TLS = nick_from_str("Tls", 3); + HTTP_NAM_PROTOCOL = nick_from_str("Protocol", 8); + HTTP_NAM_CURL_EXIT = nick_from_str("CurlExit", 8); + HTTP_NAM_CURL_SIGNAL = nick_from_str("CurlSignal", 10); + HTTP_NAM_PARSE = nick_from_str("Parse", 5); + HTTP_NAM_BODY_TOO_LARGE = nick_from_str("BodyTooLarge", 12); + HTTP_NAM_IO = nick_from_str("Io", 2); + + HTTP_NAM_REQ = nick_from_str("Req", 3); + HTTP_NAM_GET = nick_from_str("Get", 3); + HTTP_NAM_POST = nick_from_str("Post", 4); + HTTP_NAM_PUT = nick_from_str("Put", 3); + HTTP_NAM_PATCH = nick_from_str("Patch", 5); + HTTP_NAM_DELETE = nick_from_str("Delete", 6); + HTTP_NAM_HEAD = nick_from_str("Head", 4); + HTTP_NAM_OPTIONS = nick_from_str("Options", 7); + HTTP_NAM_NOBODY = nick_from_str("NoBody", 6); + HTTP_NAM_BODY_TEXT = nick_from_str("BodyText", 8); + HTTP_NAM_BODY_BYTES = nick_from_str("BodyBytes", 9); + HTTP_NAM_OPTS = nick_from_str("Opts", 4); + HTTP_NAM_T = nick_from_str("T", 1); + HTTP_NAM_F = nick_from_str("F", 1); + + prim_http_request_init(); + prim_http_poll_init(); + prim_http_wait_init(); + prim_http_cancel_init(); +} diff --git a/clang/prim/fn/http/cancel.c b/clang/prim/fn/http/cancel.c new file mode 100644 index 00000000..e82bdea6 --- /dev/null +++ b/clang/prim/fn/http/cancel.c @@ -0,0 +1,141 @@ +// %http_cancel(http) +// ------------------ +// %http_cancel_go_http(http) +fn Term prim_fn_http_cancel(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("http_cancel_go_http", 19), 1, args0); + return wnf(t); +} + +// %http_cancel_go_http(http) +// -------------------------- +// Lift `http` over ERA/INC/SUP; default forwards to io stage. +fn Term http_cancel_go_http(Term *args) { + Term http_wnf = wnf(args[0]); + + switch (term_tag(http_wnf)) { + case ERA: { + // %http_cancel_go_http(&{}) + // ------------------------- http-cancel-go-http-era + // &{} + return term_new_era(); + } + case INC: { + // %http_cancel_go_http(↑x) + // ------------------------ http-cancel-go-http-inc + // ↑(%http_cancel(x)) + u32 inc_loc = term_val(http_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("http_cancel", 11), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %http_cancel_go_http(&L{x,y}) + // ----------------------------- http-cancel-go-http-sup + // &L{%http_cancel(x), %http_cancel(y)} + u32 lab = term_ext(http_wnf); + u32 sup_loc = term_val(http_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("http_cancel", 11), 1, &x); + Term t1 = term_new_pri(table_find("http_cancel", 11), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %http_cancel_go_http(http) + // -------------------------- http-cancel-go-http-default + // %http_cancel_go_io(http) + Term args0[1] = {http_wnf}; + Term t = term_new_pri(table_find("http_cancel_go_io", 17), 1, args0); + return wnf(t); + } + } +} + +// %http_cancel_go_io(http) +// ------------------------ +// #OK{#Pend{#Http{id,seq+1}}|#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} +fn Term prim_fn_http_cancel_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!http_parse_handle(args[0], &id, &seq)) { + return http_new_err("http_cancel", HTTP_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); + } + + if (!http_is_valid_id(id)) { + return http_new_err("http_cancel", HTTP_ERR_BAD_HANDLE, "unknown http id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 parsed = 0; + u8 canceled = 0; + u8 signaled = 0; + u32 code = 0; + u32 max_body_bytes = 0; + Term outcome = term_new_era(); + char *hdr = NULL; + char *meta = NULL; + char *body = NULL; + char *err = NULL; + if (!http_claim( + id, + seq, + &pid, + &finished, + &parsed, + &canceled, + &signaled, + &code, + &max_body_bytes, + &outcome, + &hdr, + &meta, + &body, + &err + )) { + return http_new_err("http_cancel", HTTP_ERR_STALE, "stale http handle"); + } + + if (parsed) { + return http_new_ok(http_new_rdy(id, seq + 1, outcome)); + } + + if (finished) { + Term done = http_parse_and_store_outcome(id, canceled, signaled, code, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); + } + + http_set_canceled(id); + + if (kill(pid, SIGTERM) < 0 && errno != ESRCH) { + return http_new_err("http_cancel", HTTP_ERR_IO, strerror(errno)); + } + + int status = 0; + pid_t got = http_waitpid_retry(pid, &status, WNOHANG); + if (got < 0) { + if (errno == ECHILD) { + Term done = http_parse_and_store_outcome(id, 1, 0, 0, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); + } + return http_new_err("http_cancel", HTTP_ERR_IO, strerror(errno)); + } + + if (got == 0) { + return http_new_ok(http_new_pend(id, seq + 1)); + } + + http_status_from_wait(status, &signaled, &code); + http_set_finished(id, signaled, code); + + Term done = http_parse_and_store_outcome(id, 1, signaled, code, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); +} + +fn void prim_http_cancel_init(void) { + prim_register("http_cancel", 11, 1, prim_fn_http_cancel); + prim_register("http_cancel_go_http", 19, 1, http_cancel_go_http); + prim_register("http_cancel_go_io", 17, 1, prim_fn_http_cancel_go_io); +} diff --git a/clang/prim/fn/http/poll.c b/clang/prim/fn/http/poll.c new file mode 100644 index 00000000..32e8fd13 --- /dev/null +++ b/clang/prim/fn/http/poll.c @@ -0,0 +1,131 @@ +// %http_poll(http) +// ---------------- +// %http_poll_go_http(http) +fn Term prim_fn_http_poll(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("http_poll_go_http", 17), 1, args0); + return wnf(t); +} + +// %http_poll_go_http(http) +// ------------------------ +// Lift `http` over ERA/INC/SUP; default forwards to io stage. +fn Term http_poll_go_http(Term *args) { + Term http_wnf = wnf(args[0]); + + switch (term_tag(http_wnf)) { + case ERA: { + // %http_poll_go_http(&{}) + // ----------------------- http-poll-go-http-era + // &{} + return term_new_era(); + } + case INC: { + // %http_poll_go_http(↑x) + // ---------------------- http-poll-go-http-inc + // ↑(%http_poll(x)) + u32 inc_loc = term_val(http_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("http_poll", 9), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %http_poll_go_http(&L{x,y}) + // --------------------------- http-poll-go-http-sup + // &L{%http_poll(x), %http_poll(y)} + u32 lab = term_ext(http_wnf); + u32 sup_loc = term_val(http_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("http_poll", 9), 1, &x); + Term t1 = term_new_pri(table_find("http_poll", 9), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %http_poll_go_http(http) + // ------------------------ http-poll-go-http-default + // %http_poll_go_io(http) + Term args0[1] = {http_wnf}; + Term t = term_new_pri(table_find("http_poll_go_io", 15), 1, args0); + return wnf(t); + } + } +} + +// %http_poll_go_io(http) +// ---------------------- +// #OK{#Pend{#Http{id,seq+1}}|#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} +fn Term prim_fn_http_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!http_parse_handle(args[0], &id, &seq)) { + return http_new_err("http_poll", HTTP_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); + } + + if (!http_is_valid_id(id)) { + return http_new_err("http_poll", HTTP_ERR_BAD_HANDLE, "unknown http id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 parsed = 0; + u8 canceled = 0; + u8 signaled = 0; + u32 code = 0; + u32 max_body_bytes = 0; + Term outcome = term_new_era(); + char *hdr = NULL; + char *meta = NULL; + char *body = NULL; + char *err = NULL; + if (!http_claim( + id, + seq, + &pid, + &finished, + &parsed, + &canceled, + &signaled, + &code, + &max_body_bytes, + &outcome, + &hdr, + &meta, + &body, + &err + )) { + return http_new_err("http_poll", HTTP_ERR_STALE, "stale http handle"); + } + + if (parsed) { + return http_new_ok(http_new_rdy(id, seq + 1, outcome)); + } + + if (finished) { + Term done = http_parse_and_store_outcome(id, canceled, signaled, code, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); + } + + int status = 0; + pid_t got = http_waitpid_retry(pid, &status, WNOHANG); + if (got < 0) { + return http_new_err("http_poll", HTTP_ERR_IO, strerror(errno)); + } + + if (got == 0) { + return http_new_ok(http_new_pend(id, seq + 1)); + } + + http_status_from_wait(status, &signaled, &code); + http_set_finished(id, signaled, code); + + Term done = http_parse_and_store_outcome(id, canceled, signaled, code, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); +} + +fn void prim_http_poll_init(void) { + prim_register("http_poll", 9, 1, prim_fn_http_poll); + prim_register("http_poll_go_http", 17, 1, http_poll_go_http); + prim_register("http_poll_go_io", 15, 1, prim_fn_http_poll_go_io); +} diff --git a/clang/prim/fn/http/request.c b/clang/prim/fn/http/request.c new file mode 100644 index 00000000..f252b122 --- /dev/null +++ b/clang/prim/fn/http/request.c @@ -0,0 +1,152 @@ +// %http_request(req) +// ------------------ +// %http_request_go_req(req) +fn Term prim_fn_http_request(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("http_request_go_req", 19), 1, args0); + return wnf(t); +} + +// %http_request_go_req(req) +// ------------------------- +// Lift `req` over ERA/INC/SUP; default forwards to io stage. +fn Term http_request_go_req(Term *args) { + Term req_wnf = wnf(args[0]); + + switch (term_tag(req_wnf)) { + case ERA: { + // %http_request_go_req(&{}) + // ------------------------- http-request-go-req-era + // &{} + return term_new_era(); + } + case INC: { + // %http_request_go_req(↑x) + // ------------------------ http-request-go-req-inc + // ↑(%http_request(x)) + u32 inc_loc = term_val(req_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("http_request", 12), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %http_request_go_req(&L{x,y}) + // ----------------------------- http-request-go-req-sup + // &L{%http_request(x), %http_request(y)} + u32 lab = term_ext(req_wnf); + u32 sup_loc = term_val(req_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("http_request", 12), 1, &x); + Term t1 = term_new_pri(table_find("http_request", 12), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %http_request_go_req(req) + // ------------------------- http-request-go-req-default + // %http_request_go_io(req) + Term args0[1] = {req_wnf}; + Term t = term_new_pri(table_find("http_request_go_io", 18), 1, args0); + return wnf(t); + } + } +} + +// %http_request_go_io(req) +// ------------------------ +// #OK{#Http{id,0}} | #ERR{String} +fn Term prim_fn_http_request_go_io(Term *args) { + HttpReq req; + http_req_init(&req); + + Term parse_err = term_new_era(); + if (!http_parse_request(args[0], &req, &parse_err)) { + http_req_free(&req); + return parse_err; + } + + char *tmp_dir = NULL; + char *hdr_path = NULL; + char *body_path = NULL; + char *meta_path = NULL; + char *err_path = NULL; + char *req_path = NULL; + + if (!http_make_paths(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path, &req_path)) { + http_req_free(&req); + return http_new_err("http_request", HTTP_ERR_IO, "failed to allocate temporary files"); + } + + if (!http_write_body_file(req_path, &req)) { + int err = errno; + http_req_free(&req); + http_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path, &req_path); + return http_new_err("http_request", HTTP_ERR_IO, strerror(err)); + } + + pid_t pid = fork(); + if (pid < 0) { + int err = errno; + http_req_free(&req); + http_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path, &req_path); + return http_new_err("http_request", HTTP_ERR_IO, strerror(err)); + } + + if (pid == 0) { + http_child_exec_request(&req, hdr_path, body_path, meta_path, err_path, req_path); + } + + u32 max_body_bytes = req.max_body_bytes; + http_req_free(&req); + + pthread_mutex_lock(&HTTP_LOCK); + + u32 id = HTTP_NEXT_ID; + if (id >= HTTP_CAP) { + pthread_mutex_unlock(&HTTP_LOCK); + + if (kill(pid, SIGKILL) < 0 && errno != ESRCH) { + http_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path, &req_path); + return http_new_err("http_request", HTTP_ERR_IO, strerror(errno)); + } + + int status = 0; + pid_t got = http_waitpid_retry(pid, &status, 0); + if (got < 0 && errno != ECHILD) { + http_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path, &req_path); + return http_new_err("http_request", HTTP_ERR_IO, strerror(errno)); + } + + http_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path, &req_path); + return http_new_err("http_request", HTTP_ERR_FULL, "http table is full"); + } + + HTTP_NEXT_ID = id + 1; + + HttpSlot *slot = &HTTP_SLOTS[id]; + slot->expected_seq = 0; + slot->pid = pid; + slot->finished = 0; + slot->canceled = 0; + slot->signaled = 0; + slot->parsed = 0; + slot->code = 0; + slot->max_body_bytes = max_body_bytes; + slot->outcome = term_new_era(); + slot->tmp_dir = tmp_dir; + slot->hdr_path = hdr_path; + slot->body_path = body_path; + slot->meta_path = meta_path; + slot->err_path = err_path; + slot->req_path = req_path; + + pthread_mutex_unlock(&HTTP_LOCK); + return http_new_ok(http_new_http(id, 0)); +} + +fn void prim_http_request_init(void) { + prim_register("http_request", 12, 1, prim_fn_http_request); + prim_register("http_request_go_req", 19, 1, http_request_go_req); + prim_register("http_request_go_io", 18, 1, prim_fn_http_request_go_io); +} diff --git a/clang/prim/fn/http/wait.c b/clang/prim/fn/http/wait.c new file mode 100644 index 00000000..e6bbbdff --- /dev/null +++ b/clang/prim/fn/http/wait.c @@ -0,0 +1,127 @@ +// %http_wait(http) +// ---------------- +// %http_wait_go_http(http) +fn Term prim_fn_http_wait(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("http_wait_go_http", 17), 1, args0); + return wnf(t); +} + +// %http_wait_go_http(http) +// ------------------------ +// Lift `http` over ERA/INC/SUP; default forwards to io stage. +fn Term http_wait_go_http(Term *args) { + Term http_wnf = wnf(args[0]); + + switch (term_tag(http_wnf)) { + case ERA: { + // %http_wait_go_http(&{}) + // ----------------------- http-wait-go-http-era + // &{} + return term_new_era(); + } + case INC: { + // %http_wait_go_http(↑x) + // ---------------------- http-wait-go-http-inc + // ↑(%http_wait(x)) + u32 inc_loc = term_val(http_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("http_wait", 9), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %http_wait_go_http(&L{x,y}) + // --------------------------- http-wait-go-http-sup + // &L{%http_wait(x), %http_wait(y)} + u32 lab = term_ext(http_wnf); + u32 sup_loc = term_val(http_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("http_wait", 9), 1, &x); + Term t1 = term_new_pri(table_find("http_wait", 9), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %http_wait_go_http(http) + // ------------------------ http-wait-go-http-default + // %http_wait_go_io(http) + Term args0[1] = {http_wnf}; + Term t = term_new_pri(table_find("http_wait_go_io", 15), 1, args0); + return wnf(t); + } + } +} + +// %http_wait_go_io(http) +// ---------------------- +// #OK{#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} +fn Term prim_fn_http_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!http_parse_handle(args[0], &id, &seq)) { + return http_new_err("http_wait", HTTP_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); + } + + if (!http_is_valid_id(id)) { + return http_new_err("http_wait", HTTP_ERR_BAD_HANDLE, "unknown http id"); + } + + pid_t pid = 0; + u8 finished = 0; + u8 parsed = 0; + u8 canceled = 0; + u8 signaled = 0; + u32 code = 0; + u32 max_body_bytes = 0; + Term outcome = term_new_era(); + char *hdr = NULL; + char *meta = NULL; + char *body = NULL; + char *err = NULL; + if (!http_claim( + id, + seq, + &pid, + &finished, + &parsed, + &canceled, + &signaled, + &code, + &max_body_bytes, + &outcome, + &hdr, + &meta, + &body, + &err + )) { + return http_new_err("http_wait", HTTP_ERR_STALE, "stale http handle"); + } + + if (parsed) { + return http_new_ok(http_new_rdy(id, seq + 1, outcome)); + } + + if (finished) { + Term done = http_parse_and_store_outcome(id, canceled, signaled, code, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); + } + + int status = 0; + pid_t got = http_waitpid_retry(pid, &status, 0); + if (got < 0) { + return http_new_err("http_wait", HTTP_ERR_IO, strerror(errno)); + } + + http_status_from_wait(status, &signaled, &code); + http_set_finished(id, signaled, code); + + Term done = http_parse_and_store_outcome(id, canceled, signaled, code, max_body_bytes, hdr, meta, body, err); + return http_new_ok(http_new_rdy(id, seq + 1, done)); +} + +fn void prim_http_wait_init(void) { + prim_register("http_wait", 9, 1, prim_fn_http_wait); + prim_register("http_wait_go_http", 17, 1, http_wait_go_http); + prim_register("http_wait_go_io", 15, 1, prim_fn_http_wait_go_io); +} diff --git a/clang/prim/fn/https/_.c b/clang/prim/fn/https/_.c deleted file mode 100644 index 59e7530b..00000000 --- a/clang/prim/fn/https/_.c +++ /dev/null @@ -1,548 +0,0 @@ -#include -#include -#include -#include - -#define HTTPS_CAP (1u << 18) -#define HTTPS_BODY_CAP (1u << 20) - -#define HTTPS_ERR_BAD_ARG 1 -#define HTTPS_ERR_BAD_HANDLE 2 -#define HTTPS_ERR_STALE 3 -#define HTTPS_ERR_FULL 4 -#define HTTPS_ERR_IO 5 - -#define HTTPS_FAIL_CURL_EXIT 1 -#define HTTPS_FAIL_CURL_SIGNAL 2 -#define HTTPS_FAIL_PARSE 3 -#define HTTPS_FAIL_BODY 4 - -typedef struct { - u32 expected_seq; - pid_t pid; - u8 finished; - u8 canceled; - u8 signaled; - u8 parsed; - u32 code; - Term outcome; - - char *tmp_dir; - char *hdr_path; - char *body_path; - char *meta_path; - char *err_path; -} HttpsSlot; - -static HttpsSlot HTTPS_SLOTS[HTTPS_CAP]; -static u32 HTTPS_NEXT_ID = 1; -static pthread_mutex_t HTTPS_LOCK = PTHREAD_MUTEX_INITIALIZER; - -static u32 HTTPS_NAM_HTTP = 0; -static u32 HTTPS_NAM_PEND = 0; -static u32 HTTPS_NAM_RDY = 0; -static u32 HTTPS_NAM_RESP = 0; -static u32 HTTPS_NAM_HDR = 0; -static u32 HTTPS_NAM_FAIL = 0; -static u32 HTTPS_NAM_CANCELED = 0; - -fn Term wnf(Term term); - -fn Term https_new_err(const char *prim, u32 code, const char *msg) { - Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); - return term_new_ctr(NAM_ERR, 1, &txt); -} - -fn Term https_new_ok(Term val) { - return term_new_ctr(NAM_OK, 1, &val); -} - -fn Term https_new_http(u32 id, u32 seq) { - Term args[2] = {term_new_num(id), term_new_num(seq)}; - return term_new_ctr(HTTPS_NAM_HTTP, 2, args); -} - -fn Term https_new_pend(u32 id, u32 seq) { - Term http = https_new_http(id, seq); - return term_new_ctr(HTTPS_NAM_PEND, 1, &http); -} - -fn Term https_new_rdy(u32 id, u32 seq, Term outcome) { - Term http = https_new_http(id, seq); - Term args[2] = {http, outcome}; - return term_new_ctr(HTTPS_NAM_RDY, 2, args); -} - -fn Term https_new_fail(u32 code, Term msg) { - Term args[2] = {term_new_num(code), msg}; - return term_new_ctr(HTTPS_NAM_FAIL, 2, args); -} - -fn Term https_new_canceled(void) { - return term_new_ctr(HTTPS_NAM_CANCELED, 0, NULL); -} - -fn Term https_new_resp(u32 status, Term headers, Term body) { - Term args[3] = {term_new_num(status), headers, body}; - return term_new_ctr(HTTPS_NAM_RESP, 3, args); -} - -fn u8 https_parse_num(Term term, u32 *out) { - Term val = wnf(term); - - switch (term_tag(val)) { - case NUM: { - *out = term_val(val); - return 1; - } - default: { - return 0; - } - } -} - -fn u8 https_parse_handle(Term term, u32 *id, u32 *seq) { - Term val = wnf(term); - - switch (term_tag(val)) { - case C02: { - if (term_ext(val) != HTTPS_NAM_HTTP) { - return 0; - } - - u32 loc = term_val(val); - Term id_tm = heap_read(loc + 0); - Term seq_tm = heap_read(loc + 1); - - if (!https_parse_num(id_tm, id)) { - return 0; - } - if (!https_parse_num(seq_tm, seq)) { - return 0; - } - return 1; - } - default: { - return 0; - } - } -} - -fn u8 https_is_valid_id(u32 id) { - pthread_mutex_lock(&HTTPS_LOCK); - - if (id == 0 || id >= HTTPS_NEXT_ID || id >= HTTPS_CAP) { - pthread_mutex_unlock(&HTTPS_LOCK); - return 0; - } - - pthread_mutex_unlock(&HTTPS_LOCK); - return 1; -} - -fn void https_set_finished(u32 id, u8 signaled, u32 code) { - pthread_mutex_lock(&HTTPS_LOCK); - - if (id != 0 && id < HTTPS_NEXT_ID && id < HTTPS_CAP) { - HttpsSlot *slot = &HTTPS_SLOTS[id]; - slot->finished = 1; - slot->signaled = signaled; - slot->code = code; - } - - pthread_mutex_unlock(&HTTPS_LOCK); -} - -fn void https_set_canceled(u32 id) { - pthread_mutex_lock(&HTTPS_LOCK); - - if (id != 0 && id < HTTPS_NEXT_ID && id < HTTPS_CAP) { - HTTPS_SLOTS[id].canceled = 1; - } - - pthread_mutex_unlock(&HTTPS_LOCK); -} - -fn void https_status_from_wait(int status, u8 *signaled, u32 *code) { - if (WIFEXITED(status)) { - *signaled = 0; - *code = (u32)WEXITSTATUS(status); - return; - } - - if (WIFSIGNALED(status)) { - *signaled = 1; - *code = (u32)WTERMSIG(status); - return; - } - - *signaled = 0; - *code = 255; -} - -fn char *https_strdup(const char *str) { - size_t len = strlen(str); - char *out = malloc(len + 1); - if (!out) { - return NULL; - } - - memcpy(out, str, len); - out[len] = '\0'; - return out; -} - -fn char *https_join_path(const char *dir, const char *name) { - size_t dlen = strlen(dir); - size_t nlen = strlen(name); - char *out = malloc(dlen + 1 + nlen + 1); - if (!out) { - return NULL; - } - - memcpy(out, dir, dlen); - out[dlen] = '/'; - memcpy(out + dlen + 1, name, nlen); - out[dlen + 1 + nlen] = '\0'; - return out; -} - -fn void https_paths_free( - char **tmp_dir, - char **hdr_path, - char **body_path, - char **meta_path, - char **err_path -) { - if (*hdr_path) { - unlink(*hdr_path); - free(*hdr_path); - *hdr_path = NULL; - } - if (*body_path) { - unlink(*body_path); - free(*body_path); - *body_path = NULL; - } - if (*meta_path) { - unlink(*meta_path); - free(*meta_path); - *meta_path = NULL; - } - if (*err_path) { - unlink(*err_path); - free(*err_path); - *err_path = NULL; - } - if (*tmp_dir) { - rmdir(*tmp_dir); - free(*tmp_dir); - *tmp_dir = NULL; - } -} - -fn void https_slot_cleanup(HttpsSlot *slot) { - https_paths_free( - &slot->tmp_dir, - &slot->hdr_path, - &slot->body_path, - &slot->meta_path, - &slot->err_path - ); -} - -fn u8 https_make_paths( - char **tmp_dir, - char **hdr_path, - char **body_path, - char **meta_path, - char **err_path -) { - char tmpl[] = "/tmp/hvm4_https_XXXXXX"; - char *dir = https_strdup(tmpl); - if (!dir) { - return 0; - } - - if (!mkdtemp(dir)) { - free(dir); - return 0; - } - - char *hdr = https_join_path(dir, "headers.txt"); - char *body = https_join_path(dir, "body.bin"); - char *meta = https_join_path(dir, "meta.txt"); - char *err = https_join_path(dir, "err.txt"); - if (!hdr || !body || !meta || !err) { - https_paths_free(&dir, &hdr, &body, &meta, &err); - return 0; - } - - *tmp_dir = dir; - *hdr_path = hdr; - *body_path = body; - *meta_path = meta; - *err_path = err; - return 1; -} - -fn u8 https_read_status_code(const char *meta_path, u32 *status) { - FILE *f = fopen(meta_path, "rb"); - if (!f) { - return 0; - } - - char buf[64]; - size_t got = fread(buf, 1, sizeof(buf) - 1, f); - fclose(f); - buf[got] = '\0'; - - char *p = buf; - while (*p && !isdigit((unsigned char)*p)) { - p++; - } - - if (!*p) { - return 0; - } - - long code = strtol(p, NULL, 10); - if (code < 0 || code > 9999) { - return 0; - } - - *status = (u32)code; - return 1; -} - -fn Term https_read_stderr_msg(const char *err_path, const char *fallback) { - FILE *f = fopen(err_path, "rb"); - if (!f) { - return term_string_from_utf8(fallback); - } - - char buf[1024]; - size_t got = fread(buf, 1, sizeof(buf) - 1, f); - fclose(f); - - while (got > 0 && (buf[got - 1] == '\n' || buf[got - 1] == '\r')) { - got--; - } - buf[got] = '\0'; - - if (got == 0) { - return term_string_from_utf8(fallback); - } - - return term_string_from_utf8(buf); -} - -fn u8 https_read_body_bytes(const char *body_path, Term *body_out, Term *err_msg_out) { - FILE *f = fopen(body_path, "rb"); - if (!f) { - int err = errno; - *err_msg_out = term_string_printf( - "failed to open body file '%s': %s (errno=%d)", - body_path, - strerror(err), - err - ); - return 0; - } - - Term nil = term_new_ctr(NAM_NIL, 0, NULL); - unsigned char c = 0; - if (fread(&c, 1, 1, f) != 1) { - if (ferror(f)) { - int err = errno; - fclose(f); - *err_msg_out = term_string_printf( - "failed to read body file '%s': %s (errno=%d)", - body_path, - strerror(err), - err - ); - return 0; - } - fclose(f); - *body_out = nil; - return 1; - } - - u32 count = 1; - Term byt[1] = {term_new_num(c)}; - Term head_tail[2] = {term_new_ctr(NAM_BYT, 1, byt), nil}; - Term result = term_new_ctr(NAM_CON, 2, head_tail); - Term curr = result; - - while (fread(&c, 1, 1, f) == 1) { - count++; - if (count > HTTPS_BODY_CAP) { - fclose(f); - *err_msg_out = term_string_printf("response body too large (max %u bytes)", HTTPS_BODY_CAP); - return 0; - } - - byt[0] = term_new_num(c); - head_tail[0] = term_new_ctr(NAM_BYT, 1, byt); - heap_set(term_val(curr) + 1, term_new_ctr(NAM_CON, 2, head_tail)); - curr = heap_read(term_val(curr) + 1); - } - - if (ferror(f)) { - int err = errno; - fclose(f); - *err_msg_out = term_string_printf( - "failed to read body file '%s': %s (errno=%d)", - body_path, - strerror(err), - err - ); - return 0; - } - - fclose(f); - *body_out = result; - return 1; -} - -fn Term https_build_outcome( - u8 canceled, - u8 signaled, - u32 code, - const char *meta_path, - const char *body_path, - const char *err_path -) { - if (canceled) { - return https_new_canceled(); - } - - if (signaled) { - Term msg = term_string_printf("curl terminated by signal %u", code); - return https_new_fail(HTTPS_FAIL_CURL_SIGNAL, msg); - } - - if (code != 0) { - Term msg = https_read_stderr_msg(err_path, "curl request failed"); - return https_new_fail(HTTPS_FAIL_CURL_EXIT, msg); - } - - u32 status = 0; - if (!https_read_status_code(meta_path, &status)) { - Term msg = term_string_printf("failed to parse status from '%s'", meta_path); - return https_new_fail(HTTPS_FAIL_PARSE, msg); - } - - Term body = term_new_era(); - Term body_err = term_new_era(); - if (!https_read_body_bytes(body_path, &body, &body_err)) { - return https_new_fail(HTTPS_FAIL_BODY, body_err); - } - - Term headers = term_new_ctr(NAM_NIL, 0, NULL); - return https_new_resp(status, headers, body); -} - -fn void https_set_outcome(u32 id, Term outcome) { - pthread_mutex_lock(&HTTPS_LOCK); - - if (id != 0 && id < HTTPS_NEXT_ID && id < HTTPS_CAP) { - HttpsSlot *slot = &HTTPS_SLOTS[id]; - slot->outcome = outcome; - slot->parsed = 1; - https_slot_cleanup(slot); - } - - pthread_mutex_unlock(&HTTPS_LOCK); -} - -fn pid_t https_waitpid_retry(pid_t pid, int *status, int opts) { - while (1) { - pid_t got = waitpid(pid, status, opts); - if (got >= 0) { - return got; - } - if (errno == EINTR) { - continue; - } - return -1; - } -} - -fn Term https_parse_and_store_outcome( - u32 id, - u8 canceled, - u8 signaled, - u32 code, - const char *meta_path, - const char *body_path, - const char *err_path -) { - Term outcome = https_build_outcome(canceled, signaled, code, meta_path, body_path, err_path); - https_set_outcome(id, outcome); - return outcome; -} - -fn u8 https_claim( - u32 id, - u32 seq, - pid_t *pid, - u8 *finished, - u8 *parsed, - u8 *canceled, - u8 *signaled, - u32 *code, - Term *outcome, - char **body_path, - char **meta_path, - char **err_path -) { - pthread_mutex_lock(&HTTPS_LOCK); - - if (id == 0 || id >= HTTPS_NEXT_ID || id >= HTTPS_CAP) { - pthread_mutex_unlock(&HTTPS_LOCK); - return 0; - } - - HttpsSlot *slot = &HTTPS_SLOTS[id]; - if (slot->expected_seq != seq) { - pthread_mutex_unlock(&HTTPS_LOCK); - return 0; - } - - slot->expected_seq = seq + 1; - *pid = slot->pid; - *finished = slot->finished; - *parsed = slot->parsed; - *canceled = slot->canceled; - *signaled = slot->signaled; - *code = slot->code; - *outcome = slot->outcome; - *body_path = slot->body_path; - *meta_path = slot->meta_path; - *err_path = slot->err_path; - - pthread_mutex_unlock(&HTTPS_LOCK); - return 1; -} - -#include "get.c" -#include "poll.c" -#include "wait.c" -#include "cancel.c" - -fn void prim_https_init(void) { - HTTPS_NAM_HTTP = nick_from_str("Http", 4); - HTTPS_NAM_PEND = nick_from_str("Pend", 4); - HTTPS_NAM_RDY = nick_from_str("Rdy", 3); - HTTPS_NAM_RESP = nick_from_str("Resp", 4); - HTTPS_NAM_HDR = nick_from_str("Hdr", 3); - HTTPS_NAM_FAIL = nick_from_str("Fail", 4); - HTTPS_NAM_CANCELED = nick_from_str("Canceled", 8); - - prim_https_get_init(); - prim_https_poll_init(); - prim_https_wait_init(); - prim_https_cancel_init(); -} diff --git a/clang/prim/fn/https/cancel.c b/clang/prim/fn/https/cancel.c deleted file mode 100644 index d5c018db..00000000 --- a/clang/prim/fn/https/cancel.c +++ /dev/null @@ -1,137 +0,0 @@ -// %https_cancel(http) -// ------------------- -// %https_cancel_go_http(http) -fn Term prim_fn_https_cancel(Term *args) { - Term args0[1] = {args[0]}; - Term t = term_new_pri(table_find("https_cancel_go_http", 20), 1, args0); - return wnf(t); -} - -// %https_cancel_go_http(http) -// --------------------------- -// Lift `http` over ERA/INC/SUP; default forwards to io stage. -fn Term https_cancel_go_http(Term *args) { - Term http_wnf = wnf(args[0]); - - switch (term_tag(http_wnf)) { - case ERA: { - // %https_cancel_go_http(&{}) - // -------------------------- https-cancel-go-http-era - // &{} - return term_new_era(); - } - case INC: { - // %https_cancel_go_http(↑x) - // ------------------------- https-cancel-go-http-inc - // ↑(%https_cancel(x)) - u32 inc_loc = term_val(http_wnf); - Term inner = heap_read(inc_loc); - Term next = term_new_pri(table_find("https_cancel", 12), 1, &inner); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %https_cancel_go_http(&L{x,y}) - // ------------------------------ https-cancel-go-http-sup - // &L{%https_cancel(x), %https_cancel(y)} - u32 lab = term_ext(http_wnf); - u32 sup_loc = term_val(http_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Term t0 = term_new_pri(table_find("https_cancel", 12), 1, &x); - Term t1 = term_new_pri(table_find("https_cancel", 12), 1, &y); - return term_new_sup(lab, t0, t1); - } - default: { - // %https_cancel_go_http(http) - // --------------------------- https-cancel-go-http-default - // %https_cancel_go_io(http) - Term args0[1] = {http_wnf}; - Term t = term_new_pri(table_find("https_cancel_go_io", 18), 1, args0); - return wnf(t); - } - } -} - -// %https_cancel_go_io(http) -// ------------------------- -// #OK{#Pend{#Http{id,seq+1}}|#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} -fn Term prim_fn_https_cancel_go_io(Term *args) { - u32 id = 0; - u32 seq = 0; - if (!https_parse_handle(args[0], &id, &seq)) { - return https_new_err("https_cancel", HTTPS_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); - } - - if (!https_is_valid_id(id)) { - return https_new_err("https_cancel", HTTPS_ERR_BAD_HANDLE, "unknown https id"); - } - - pid_t pid = 0; - u8 finished = 0; - u8 parsed = 0; - u8 canceled = 0; - u8 signaled = 0; - u32 code = 0; - Term outcome = term_new_era(); - char *body = NULL; - char *meta = NULL; - char *err = NULL; - if (!https_claim( - id, - seq, - &pid, - &finished, - &parsed, - &canceled, - &signaled, - &code, - &outcome, - &body, - &meta, - &err - )) { - return https_new_err("https_cancel", HTTPS_ERR_STALE, "stale https handle"); - } - - if (parsed) { - return https_new_ok(https_new_rdy(id, seq + 1, outcome)); - } - - if (finished) { - Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); - } - - https_set_canceled(id); - - if (kill(pid, SIGTERM) < 0 && errno != ESRCH) { - return https_new_err("https_cancel", HTTPS_ERR_IO, strerror(errno)); - } - - int status = 0; - pid_t got = https_waitpid_retry(pid, &status, WNOHANG); - if (got < 0) { - if (errno == ECHILD) { - Term done = https_parse_and_store_outcome(id, 1, 0, 0, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); - } - return https_new_err("https_cancel", HTTPS_ERR_IO, strerror(errno)); - } - - if (got == 0) { - return https_new_ok(https_new_pend(id, seq + 1)); - } - - https_status_from_wait(status, &signaled, &code); - https_set_finished(id, signaled, code); - - Term done = https_parse_and_store_outcome(id, 1, signaled, code, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); -} - -fn void prim_https_cancel_init(void) { - prim_register("https_cancel", 12, 1, prim_fn_https_cancel); - prim_register("https_cancel_go_http", 20, 1, https_cancel_go_http); - prim_register("https_cancel_go_io", 18, 1, prim_fn_https_cancel_go_io); -} diff --git a/clang/prim/fn/https/get.c b/clang/prim/fn/https/get.c deleted file mode 100644 index e923a370..00000000 --- a/clang/prim/fn/https/get.c +++ /dev/null @@ -1,209 +0,0 @@ -// %https_get(url) -// --------------- -// %https_get_go_url(url) -fn Term prim_fn_https_get(Term *args) { - Term args0[1] = {args[0]}; - Term t = term_new_pri(table_find("https_get_go_url", 16), 1, args0); - return wnf(t); -} - -// %https_get_go_url(url) -// ---------------------- -// Lift `url` over ERA/INC/SUP; default forwards to io stage. -fn Term https_get_go_url(Term *args) { - Term url_wnf = wnf(args[0]); - - switch (term_tag(url_wnf)) { - case ERA: { - // %https_get_go_url(&{}) - // ---------------------- https-get-go-url-era - // &{} - return term_new_era(); - } - case INC: { - // %https_get_go_url(↑x) - // --------------------- https-get-go-url-inc - // ↑(%https_get(x)) - u32 inc_loc = term_val(url_wnf); - Term inner = heap_read(inc_loc); - Term next = term_new_pri(table_find("https_get", 9), 1, &inner); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %https_get_go_url(&L{x,y}) - // -------------------------- https-get-go-url-sup - // &L{%https_get(x), %https_get(y)} - u32 lab = term_ext(url_wnf); - u32 sup_loc = term_val(url_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Term t0 = term_new_pri(table_find("https_get", 9), 1, &x); - Term t1 = term_new_pri(table_find("https_get", 9), 1, &y); - return term_new_sup(lab, t0, t1); - } - default: { - // %https_get_go_url(url) - // ---------------------- https-get-go-url-default - // %https_get_go_io(url) - Term args0[1] = {url_wnf}; - Term t = term_new_pri(table_find("https_get_go_io", 15), 1, args0); - return wnf(t); - } - } -} - -fn int https_open_trunc_file(const char *path) { - while (1) { - int fd = open(path, O_WRONLY | O_CREAT | O_TRUNC, 0600); - if (fd >= 0) { - return fd; - } - if (errno == EINTR) { - continue; - } - return -1; - } -} - -fn int https_dup2_retry(int old_fd, int new_fd) { - while (1) { - if (dup2(old_fd, new_fd) >= 0) { - return 1; - } - if (errno == EINTR) { - continue; - } - return 0; - } -} - -fn void https_child_exec_get( - const char *url, - const char *hdr_path, - const char *body_path, - const char *meta_path, - const char *err_path -) { - int meta_fd = https_open_trunc_file(meta_path); - if (meta_fd < 0) { - _exit(127); - } - - int err_fd = https_open_trunc_file(err_path); - if (err_fd < 0) { - close(meta_fd); - _exit(127); - } - - if (!https_dup2_retry(meta_fd, STDOUT_FILENO)) { - close(meta_fd); - close(err_fd); - _exit(127); - } - - if (!https_dup2_retry(err_fd, STDERR_FILENO)) { - close(meta_fd); - close(err_fd); - _exit(127); - } - - close(meta_fd); - close(err_fd); - - execlp( - "curl", - "curl", - "-sS", - "-L", - "-D", hdr_path, - "-o", body_path, - "-w", "%{http_code}\n", - url, - (char *)NULL - ); - - _exit(127); -} - -// %https_get_go_io(url) -// --------------------- -// #OK{#Http{id,0}} | #ERR{String} -fn Term prim_fn_https_get_go_io(Term *args) { - int MAX_URL = 8192; - char url[MAX_URL]; - - HStrErr url_err; - if (!term_string_to_utf8_cstr(args[0], url, MAX_URL, NULL, &url_err)) { - return term_string_from_hstrerr("https_get", "url", MAX_URL, url_err); - } - - char *tmp_dir = NULL; - char *hdr_path = NULL; - char *body_path = NULL; - char *meta_path = NULL; - char *err_path = NULL; - - if (!https_make_paths(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path)) { - return https_new_err("https_get", HTTPS_ERR_IO, "failed to allocate temporary files"); - } - - pid_t pid = fork(); - if (pid < 0) { - int err = errno; - https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); - return https_new_err("https_get", HTTPS_ERR_IO, strerror(err)); - } - - if (pid == 0) { - https_child_exec_get(url, hdr_path, body_path, meta_path, err_path); - } - - pthread_mutex_lock(&HTTPS_LOCK); - - u32 id = HTTPS_NEXT_ID; - if (id >= HTTPS_CAP) { - pthread_mutex_unlock(&HTTPS_LOCK); - - if (kill(pid, SIGKILL) < 0 && errno != ESRCH) { - https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); - return https_new_err("https_get", HTTPS_ERR_IO, strerror(errno)); - } - - int status = 0; - pid_t got = https_waitpid_retry(pid, &status, 0); - if (got < 0 && errno != ECHILD) { - https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); - return https_new_err("https_get", HTTPS_ERR_IO, strerror(errno)); - } - - https_paths_free(&tmp_dir, &hdr_path, &body_path, &meta_path, &err_path); - return https_new_err("https_get", HTTPS_ERR_FULL, "https table is full"); - } - - HTTPS_NEXT_ID = id + 1; - - HttpsSlot *slot = &HTTPS_SLOTS[id]; - slot->expected_seq = 0; - slot->pid = pid; - slot->finished = 0; - slot->canceled = 0; - slot->signaled = 0; - slot->parsed = 0; - slot->code = 0; - slot->outcome = term_new_era(); - slot->tmp_dir = tmp_dir; - slot->hdr_path = hdr_path; - slot->body_path = body_path; - slot->meta_path = meta_path; - slot->err_path = err_path; - - pthread_mutex_unlock(&HTTPS_LOCK); - return https_new_ok(https_new_http(id, 0)); -} - -fn void prim_https_get_init(void) { - prim_register("https_get", 9, 1, prim_fn_https_get); - prim_register("https_get_go_url", 16, 1, https_get_go_url); - prim_register("https_get_go_io", 15, 1, prim_fn_https_get_go_io); -} diff --git a/clang/prim/fn/https/poll.c b/clang/prim/fn/https/poll.c deleted file mode 100644 index 751f476b..00000000 --- a/clang/prim/fn/https/poll.c +++ /dev/null @@ -1,127 +0,0 @@ -// %https_poll(http) -// ----------------- -// %https_poll_go_http(http) -fn Term prim_fn_https_poll(Term *args) { - Term args0[1] = {args[0]}; - Term t = term_new_pri(table_find("https_poll_go_http", 18), 1, args0); - return wnf(t); -} - -// %https_poll_go_http(http) -// ------------------------- -// Lift `http` over ERA/INC/SUP; default forwards to io stage. -fn Term https_poll_go_http(Term *args) { - Term http_wnf = wnf(args[0]); - - switch (term_tag(http_wnf)) { - case ERA: { - // %https_poll_go_http(&{}) - // ------------------------ https-poll-go-http-era - // &{} - return term_new_era(); - } - case INC: { - // %https_poll_go_http(↑x) - // ----------------------- https-poll-go-http-inc - // ↑(%https_poll(x)) - u32 inc_loc = term_val(http_wnf); - Term inner = heap_read(inc_loc); - Term next = term_new_pri(table_find("https_poll", 10), 1, &inner); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %https_poll_go_http(&L{x,y}) - // ---------------------------- https-poll-go-http-sup - // &L{%https_poll(x), %https_poll(y)} - u32 lab = term_ext(http_wnf); - u32 sup_loc = term_val(http_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Term t0 = term_new_pri(table_find("https_poll", 10), 1, &x); - Term t1 = term_new_pri(table_find("https_poll", 10), 1, &y); - return term_new_sup(lab, t0, t1); - } - default: { - // %https_poll_go_http(http) - // ------------------------- https-poll-go-http-default - // %https_poll_go_io(http) - Term args0[1] = {http_wnf}; - Term t = term_new_pri(table_find("https_poll_go_io", 16), 1, args0); - return wnf(t); - } - } -} - -// %https_poll_go_io(http) -// ----------------------- -// #OK{#Pend{#Http{id,seq+1}}|#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} -fn Term prim_fn_https_poll_go_io(Term *args) { - u32 id = 0; - u32 seq = 0; - if (!https_parse_handle(args[0], &id, &seq)) { - return https_new_err("https_poll", HTTPS_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); - } - - if (!https_is_valid_id(id)) { - return https_new_err("https_poll", HTTPS_ERR_BAD_HANDLE, "unknown https id"); - } - - pid_t pid = 0; - u8 finished = 0; - u8 parsed = 0; - u8 canceled = 0; - u8 signaled = 0; - u32 code = 0; - Term outcome = term_new_era(); - char *body = NULL; - char *meta = NULL; - char *err = NULL; - if (!https_claim( - id, - seq, - &pid, - &finished, - &parsed, - &canceled, - &signaled, - &code, - &outcome, - &body, - &meta, - &err - )) { - return https_new_err("https_poll", HTTPS_ERR_STALE, "stale https handle"); - } - - if (parsed) { - return https_new_ok(https_new_rdy(id, seq + 1, outcome)); - } - - if (finished) { - Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); - } - - int status = 0; - pid_t got = https_waitpid_retry(pid, &status, WNOHANG); - if (got < 0) { - return https_new_err("https_poll", HTTPS_ERR_IO, strerror(errno)); - } - - if (got == 0) { - return https_new_ok(https_new_pend(id, seq + 1)); - } - - https_status_from_wait(status, &signaled, &code); - https_set_finished(id, signaled, code); - - Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); -} - -fn void prim_https_poll_init(void) { - prim_register("https_poll", 10, 1, prim_fn_https_poll); - prim_register("https_poll_go_http", 18, 1, https_poll_go_http); - prim_register("https_poll_go_io", 16, 1, prim_fn_https_poll_go_io); -} diff --git a/clang/prim/fn/https/wait.c b/clang/prim/fn/https/wait.c deleted file mode 100644 index fef58973..00000000 --- a/clang/prim/fn/https/wait.c +++ /dev/null @@ -1,123 +0,0 @@ -// %https_wait(http) -// ----------------- -// %https_wait_go_http(http) -fn Term prim_fn_https_wait(Term *args) { - Term args0[1] = {args[0]}; - Term t = term_new_pri(table_find("https_wait_go_http", 18), 1, args0); - return wnf(t); -} - -// %https_wait_go_http(http) -// ------------------------- -// Lift `http` over ERA/INC/SUP; default forwards to io stage. -fn Term https_wait_go_http(Term *args) { - Term http_wnf = wnf(args[0]); - - switch (term_tag(http_wnf)) { - case ERA: { - // %https_wait_go_http(&{}) - // ------------------------ https-wait-go-http-era - // &{} - return term_new_era(); - } - case INC: { - // %https_wait_go_http(↑x) - // ----------------------- https-wait-go-http-inc - // ↑(%https_wait(x)) - u32 inc_loc = term_val(http_wnf); - Term inner = heap_read(inc_loc); - Term next = term_new_pri(table_find("https_wait", 10), 1, &inner); - heap_set(inc_loc, next); - return term_new(0, INC, 0, inc_loc); - } - case SUP: { - // %https_wait_go_http(&L{x,y}) - // ---------------------------- https-wait-go-http-sup - // &L{%https_wait(x), %https_wait(y)} - u32 lab = term_ext(http_wnf); - u32 sup_loc = term_val(http_wnf); - Term x = heap_read(sup_loc + 0); - Term y = heap_read(sup_loc + 1); - Term t0 = term_new_pri(table_find("https_wait", 10), 1, &x); - Term t1 = term_new_pri(table_find("https_wait", 10), 1, &y); - return term_new_sup(lab, t0, t1); - } - default: { - // %https_wait_go_http(http) - // ------------------------- https-wait-go-http-default - // %https_wait_go_io(http) - Term args0[1] = {http_wnf}; - Term t = term_new_pri(table_find("https_wait_go_io", 16), 1, args0); - return wnf(t); - } - } -} - -// %https_wait_go_io(http) -// ----------------------- -// #OK{#Rdy{#Http{id,seq+1},outcome}} | #ERR{String} -fn Term prim_fn_https_wait_go_io(Term *args) { - u32 id = 0; - u32 seq = 0; - if (!https_parse_handle(args[0], &id, &seq)) { - return https_new_err("https_wait", HTTPS_ERR_BAD_HANDLE, "invalid `http`; expected #Http{id,seq}"); - } - - if (!https_is_valid_id(id)) { - return https_new_err("https_wait", HTTPS_ERR_BAD_HANDLE, "unknown https id"); - } - - pid_t pid = 0; - u8 finished = 0; - u8 parsed = 0; - u8 canceled = 0; - u8 signaled = 0; - u32 code = 0; - Term outcome = term_new_era(); - char *body = NULL; - char *meta = NULL; - char *err = NULL; - if (!https_claim( - id, - seq, - &pid, - &finished, - &parsed, - &canceled, - &signaled, - &code, - &outcome, - &body, - &meta, - &err - )) { - return https_new_err("https_wait", HTTPS_ERR_STALE, "stale https handle"); - } - - if (parsed) { - return https_new_ok(https_new_rdy(id, seq + 1, outcome)); - } - - if (finished) { - Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); - } - - int status = 0; - pid_t got = https_waitpid_retry(pid, &status, 0); - if (got < 0) { - return https_new_err("https_wait", HTTPS_ERR_IO, strerror(errno)); - } - - https_status_from_wait(status, &signaled, &code); - https_set_finished(id, signaled, code); - - Term done = https_parse_and_store_outcome(id, canceled, signaled, code, meta, body, err); - return https_new_ok(https_new_rdy(id, seq + 1, done)); -} - -fn void prim_https_wait_init(void) { - prim_register("https_wait", 10, 1, prim_fn_https_wait); - prim_register("https_wait_go_http", 18, 1, https_wait_go_http); - prim_register("https_wait_go_io", 16, 1, prim_fn_https_wait_go_io); -} From c62920ef7fc2a216766a595a8744c74cc4e18889 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Wed, 11 Feb 2026 07:39:31 -0300 Subject: [PATCH 24/35] tcp prims --- clang/prim/fn/tcp/_.c | 708 +++++++++++++++++++++++++++++++ clang/prim/fn/tcp/close.c | 102 +++++ clang/prim/fn/tcp/connect.c | 179 ++++++++ clang/prim/fn/tcp/connect_poll.c | 121 ++++++ clang/prim/fn/tcp/connect_wait.c | 122 ++++++ clang/prim/fn/tcp/recv_poll.c | 198 +++++++++ clang/prim/fn/tcp/recv_wait.c | 220 ++++++++++ clang/prim/fn/tcp/send_poll.c | 194 +++++++++ clang/prim/fn/tcp/send_wait.c | 216 ++++++++++ 9 files changed, 2060 insertions(+) create mode 100644 clang/prim/fn/tcp/_.c create mode 100644 clang/prim/fn/tcp/close.c create mode 100644 clang/prim/fn/tcp/connect.c create mode 100644 clang/prim/fn/tcp/connect_poll.c create mode 100644 clang/prim/fn/tcp/connect_wait.c create mode 100644 clang/prim/fn/tcp/recv_poll.c create mode 100644 clang/prim/fn/tcp/recv_wait.c create mode 100644 clang/prim/fn/tcp/send_poll.c create mode 100644 clang/prim/fn/tcp/send_wait.c diff --git a/clang/prim/fn/tcp/_.c b/clang/prim/fn/tcp/_.c new file mode 100644 index 00000000..dfd219cd --- /dev/null +++ b/clang/prim/fn/tcp/_.c @@ -0,0 +1,708 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +#ifndef MSG_NOSIGNAL +#define MSG_NOSIGNAL 0 +#endif + +#define TCP_CAP (1u << 20) +#define TCP_HOST_CAP 1024 +#define TCP_RECV_CAP (1u << 20) +#define TCP_SEND_CAP (1u << 20) + +#define TCP_ERR_BAD_ARG 1 +#define TCP_ERR_BAD_HANDLE 2 +#define TCP_ERR_STALE 3 +#define TCP_ERR_FULL 4 +#define TCP_ERR_IO 5 + +#define TCP_STATE_CONNECTING 1 +#define TCP_STATE_OPEN 2 +#define TCP_STATE_REMOTE_EOF 3 +#define TCP_STATE_CLOSED 4 +#define TCP_STATE_FAILED 5 + +#define TCP_FAIL_TIMEOUT 1 +#define TCP_FAIL_DNS 2 +#define TCP_FAIL_REFUSED 3 +#define TCP_FAIL_UNREACHABLE 4 +#define TCP_FAIL_RESET 5 +#define TCP_FAIL_BROKEN_PIPE 6 +#define TCP_FAIL_PROTOCOL 7 +#define TCP_FAIL_NOT_CONNECTED 8 +#define TCP_FAIL_SYS 9 + +typedef struct { + u32 expected_seq; + int fd; + u8 state; + u32 connect_timeout_ms; + u32 read_timeout_ms; + u32 write_timeout_ms; + u64 connect_start_ms; +} TcpSlot; + +typedef struct { + int fd; + u8 state; + u32 connect_timeout_ms; + u32 read_timeout_ms; + u32 write_timeout_ms; + u64 connect_start_ms; +} TcpSnap; + +static TcpSlot TCP_SLOTS[TCP_CAP]; +static u32 TCP_NEXT_ID = 1; +static pthread_mutex_t TCP_LOCK = PTHREAD_MUTEX_INITIALIZER; + +static u32 TCP_NAM_TCP = 0; +static u32 TCP_NAM_TCP_REQ = 0; +static u32 TCP_NAM_TCP_OPTS = 0; + +static u32 TCP_NAM_PEND = 0; +static u32 TCP_NAM_RDY = 0; +static u32 TCP_NAM_CONN = 0; +static u32 TCP_NAM_RECV = 0; +static u32 TCP_NAM_SENT = 0; +static u32 TCP_NAM_EOF = 0; +static u32 TCP_NAM_CLOSED = 0; +static u32 TCP_NAM_FAIL = 0; + +static u32 TCP_NAM_TIMEOUT = 0; +static u32 TCP_NAM_DNS = 0; +static u32 TCP_NAM_REFUSED = 0; +static u32 TCP_NAM_UNREACHABLE = 0; +static u32 TCP_NAM_RESET = 0; +static u32 TCP_NAM_BROKEN_PIPE = 0; +static u32 TCP_NAM_PROTOCOL = 0; +static u32 TCP_NAM_NOT_CONNECTED = 0; +static u32 TCP_NAM_SYS = 0; + +static u32 TCP_NAM_T = 0; +static u32 TCP_NAM_F = 0; + +fn Term wnf(Term term); + +fn Term tcp_new_err(const char *prim, u32 code, const char *msg) { + Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); + return term_new_ctr(NAM_ERR, 1, &txt); +} + +fn Term tcp_new_ok(Term val) { + return term_new_ctr(NAM_OK, 1, &val); +} + +fn Term tcp_new_tcp(u32 id, u32 seq) { + Term args[2] = {term_new_num(id), term_new_num(seq)}; + return term_new_ctr(TCP_NAM_TCP, 2, args); +} + +fn Term tcp_new_pend(u32 id, u32 seq) { + Term tcp = tcp_new_tcp(id, seq); + return term_new_ctr(TCP_NAM_PEND, 1, &tcp); +} + +fn Term tcp_new_rdy(u32 id, u32 seq, Term evt) { + Term tcp = tcp_new_tcp(id, seq); + Term args[2] = {tcp, evt}; + return term_new_ctr(TCP_NAM_RDY, 2, args); +} + +fn Term tcp_new_conn_evt(void) { + return term_new_ctr(TCP_NAM_CONN, 0, NULL); +} + +fn Term tcp_new_recv_evt(Term bytes) { + return term_new_ctr(TCP_NAM_RECV, 1, &bytes); +} + +fn Term tcp_new_sent_evt(u32 n) { + Term arg = term_new_num(n); + return term_new_ctr(TCP_NAM_SENT, 1, &arg); +} + +fn Term tcp_new_eof_evt(void) { + return term_new_ctr(TCP_NAM_EOF, 0, NULL); +} + +fn Term tcp_new_closed_evt(void) { + return term_new_ctr(TCP_NAM_CLOSED, 0, NULL); +} + +fn Term tcp_new_reason(u8 kind, u32 code) { + switch (kind) { + case TCP_FAIL_TIMEOUT: { + return term_new_ctr(TCP_NAM_TIMEOUT, 0, NULL); + } + case TCP_FAIL_DNS: { + return term_new_ctr(TCP_NAM_DNS, 0, NULL); + } + case TCP_FAIL_REFUSED: { + return term_new_ctr(TCP_NAM_REFUSED, 0, NULL); + } + case TCP_FAIL_UNREACHABLE: { + return term_new_ctr(TCP_NAM_UNREACHABLE, 0, NULL); + } + case TCP_FAIL_RESET: { + return term_new_ctr(TCP_NAM_RESET, 0, NULL); + } + case TCP_FAIL_BROKEN_PIPE: { + return term_new_ctr(TCP_NAM_BROKEN_PIPE, 0, NULL); + } + case TCP_FAIL_PROTOCOL: { + return term_new_ctr(TCP_NAM_PROTOCOL, 0, NULL); + } + case TCP_FAIL_NOT_CONNECTED: { + return term_new_ctr(TCP_NAM_NOT_CONNECTED, 0, NULL); + } + default: { + Term arg = term_new_num(code); + return term_new_ctr(TCP_NAM_SYS, 1, &arg); + } + } +} + +fn Term tcp_new_fail_evt(Term reason, Term msg) { + Term args[2] = {reason, msg}; + return term_new_ctr(TCP_NAM_FAIL, 2, args); +} + +fn Term tcp_fail_evt(u8 kind, u32 code, const char *msg) { + Term reason = tcp_new_reason(kind, code); + Term text = term_string_from_utf8(msg); + return tcp_new_fail_evt(reason, text); +} + +fn Term tcp_fail_not_connected_evt(void) { + return tcp_fail_evt(TCP_FAIL_NOT_CONNECTED, 0, "socket is not connected"); +} + +fn Term tcp_fail_timeout_evt(const char *op) { + Term reason = tcp_new_reason(TCP_FAIL_TIMEOUT, 0); + Term msg = term_string_printf("%s timeout", op); + return tcp_new_fail_evt(reason, msg); +} + +fn Term tcp_fail_from_errno_evt(const char *op, int err) { + u8 kind = TCP_FAIL_SYS; + + switch (err) { + case ETIMEDOUT: { + kind = TCP_FAIL_TIMEOUT; + break; + } + case ECONNREFUSED: { + kind = TCP_FAIL_REFUSED; + break; + } + case EHOSTUNREACH: + case ENETUNREACH: { + kind = TCP_FAIL_UNREACHABLE; + break; + } + case ECONNRESET: { + kind = TCP_FAIL_RESET; + break; + } + case EPIPE: { + kind = TCP_FAIL_BROKEN_PIPE; + break; + } + case ENOTCONN: { + kind = TCP_FAIL_NOT_CONNECTED; + break; + } + case EPROTO: + case EPROTONOSUPPORT: + case EPROTOTYPE: { + kind = TCP_FAIL_PROTOCOL; + break; + } + default: { + kind = TCP_FAIL_SYS; + break; + } + } + + Term reason = tcp_new_reason(kind, (u32)err); + Term msg = term_string_printf("%s: %s (errno=%d)", op, strerror(err), err); + return tcp_new_fail_evt(reason, msg); +} + +fn Term tcp_fail_from_gai_evt(const char *op, int gai_err) { + if (gai_err == EAI_NONAME || gai_err == EAI_AGAIN) { + Term reason = tcp_new_reason(TCP_FAIL_DNS, 0); + Term msg = term_string_printf("%s: %s (gai=%d)", op, gai_strerror(gai_err), gai_err); + return tcp_new_fail_evt(reason, msg); + } + + Term reason = tcp_new_reason(TCP_FAIL_SYS, (u32)(gai_err < 0 ? -gai_err : gai_err)); + Term msg = term_string_printf("%s: %s (gai=%d)", op, gai_strerror(gai_err), gai_err); + return tcp_new_fail_evt(reason, msg); +} + +fn u64 tcp_now_ms(void) { + struct timespec ts; + clock_gettime(CLOCK_MONOTONIC, &ts); + return (u64)ts.tv_sec * 1000ull + (u64)ts.tv_nsec / 1000000ull; +} + +fn int tcp_timeout_to_poll_ms(u64 start_ms, u32 timeout_ms) { + if (timeout_ms == 0) { + return -1; + } + + u64 now = tcp_now_ms(); + if (now >= start_ms + (u64)timeout_ms) { + return 0; + } + + u64 rem = (start_ms + (u64)timeout_ms) - now; + if (rem > (u64)INT_MAX) { + return INT_MAX; + } + + return (int)rem; +} + +fn u8 tcp_parse_num(Term term, u32 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case NUM: { + *out = term_val(val); + return 1; + } + default: { + return 0; + } + } +} + +fn u8 tcp_parse_bool(Term term, u8 *out) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C00: { + u32 ext = term_ext(val); + if (ext == TCP_NAM_T) { + *out = 1; + return 1; + } + if (ext == TCP_NAM_F) { + *out = 0; + return 1; + } + return 0; + } + default: { + return 0; + } + } +} + +fn u8 tcp_parse_handle(Term term, u32 *id, u32 *seq) { + Term val = wnf(term); + + switch (term_tag(val)) { + case C02: { + if (term_ext(val) != TCP_NAM_TCP) { + return 0; + } + + u32 loc = term_val(val); + Term id_tm = heap_read(loc + 0); + Term seq_tm = heap_read(loc + 1); + + if (!tcp_parse_num(id_tm, id)) { + return 0; + } + if (!tcp_parse_num(seq_tm, seq)) { + return 0; + } + return 1; + } + default: { + return 0; + } + } +} + +fn u8 tcp_is_valid_id(u32 id) { + pthread_mutex_lock(&TCP_LOCK); + + if (id == 0 || id >= TCP_NEXT_ID || id >= TCP_CAP) { + pthread_mutex_unlock(&TCP_LOCK); + return 0; + } + + pthread_mutex_unlock(&TCP_LOCK); + return 1; +} + +fn u8 tcp_claim(u32 id, u32 seq, TcpSnap *out) { + pthread_mutex_lock(&TCP_LOCK); + + if (id == 0 || id >= TCP_NEXT_ID || id >= TCP_CAP) { + pthread_mutex_unlock(&TCP_LOCK); + return 0; + } + + TcpSlot *slot = &TCP_SLOTS[id]; + if (slot->expected_seq != seq) { + pthread_mutex_unlock(&TCP_LOCK); + return 0; + } + + slot->expected_seq = seq + 1; + out->fd = slot->fd; + out->state = slot->state; + out->connect_timeout_ms = slot->connect_timeout_ms; + out->read_timeout_ms = slot->read_timeout_ms; + out->write_timeout_ms = slot->write_timeout_ms; + out->connect_start_ms = slot->connect_start_ms; + + pthread_mutex_unlock(&TCP_LOCK); + return 1; +} + +fn void tcp_slot_set_fd_state(u32 id, int fd, u8 state) { + pthread_mutex_lock(&TCP_LOCK); + + if (id != 0 && id < TCP_NEXT_ID && id < TCP_CAP) { + TcpSlot *slot = &TCP_SLOTS[id]; + slot->fd = fd; + slot->state = state; + } + + pthread_mutex_unlock(&TCP_LOCK); +} + +fn int tcp_close_fd(int fd) { + while (1) { + if (close(fd) == 0) { + return 1; + } + if (errno == EINTR) { + continue; + } + return 0; + } +} + +fn void tcp_slot_close_and_set(u32 id, int fd, u8 state) { + if (fd >= 0) { + tcp_close_fd(fd); + } + tcp_slot_set_fd_state(id, -1, state); +} + +fn int tcp_set_nonblocking(int fd) { + int flags = fcntl(fd, F_GETFL, 0); + if (flags < 0) { + return 0; + } + + if (fcntl(fd, F_SETFL, flags | O_NONBLOCK) < 0) { + return 0; + } + + return 1; +} + +fn int tcp_apply_sockopts(int fd, u8 nodelay, u8 keepalive) { +#ifdef SO_NOSIGPIPE + { + int on = 1; + if (setsockopt(fd, SOL_SOCKET, SO_NOSIGPIPE, &on, sizeof(on)) < 0) { + return 0; + } + } +#endif + + if (nodelay) { + int on = 1; + if (setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, &on, sizeof(on)) < 0) { + return 0; + } + } + + if (keepalive) { + int on = 1; + if (setsockopt(fd, SOL_SOCKET, SO_KEEPALIVE, &on, sizeof(on)) < 0) { + return 0; + } + } + + return 1; +} + +fn u8 tcp_parse_req( + Term req_tm, + char host[TCP_HOST_CAP], + u32 *port, + u32 *connect_timeout_ms, + u32 *read_timeout_ms, + u32 *write_timeout_ms, + u8 *nodelay, + u8 *keepalive, + Term *err_out +) { + Term req = wnf(req_tm); + + if (term_tag(req) != C03 || term_ext(req) != TCP_NAM_TCP_REQ) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `req`; expected #TcpReq{host,port,opts}"); + return 0; + } + + u32 req_loc = term_val(req); + Term host_tm = heap_read(req_loc + 0); + Term port_tm = heap_read(req_loc + 1); + Term opts_tm = heap_read(req_loc + 2); + + HStrErr host_err; + if (!term_string_to_utf8_cstr(host_tm, host, TCP_HOST_CAP, NULL, &host_err)) { + *err_out = term_string_from_hstrerr("tcp_connect", "host", TCP_HOST_CAP, host_err); + return 0; + } + + if (!tcp_parse_num(port_tm, port) || *port == 0 || *port > 65535) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `port`; expected NUM in [1,65535]"); + return 0; + } + + Term opts = wnf(opts_tm); + if (term_tag(opts) != C05 || term_ext(opts) != TCP_NAM_TCP_OPTS) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `opts`; expected #TcpOpts{connect_timeout_ms,read_timeout_ms,write_timeout_ms,nodelay,keepalive}"); + return 0; + } + + u32 opts_loc = term_val(opts); + Term connect_tm = heap_read(opts_loc + 0); + Term read_tm = heap_read(opts_loc + 1); + Term write_tm = heap_read(opts_loc + 2); + Term nodelay_tm = heap_read(opts_loc + 3); + Term keep_tm = heap_read(opts_loc + 4); + + if (!tcp_parse_num(connect_tm, connect_timeout_ms)) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `connect_timeout_ms`; expected NUM"); + return 0; + } + if (!tcp_parse_num(read_tm, read_timeout_ms)) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `read_timeout_ms`; expected NUM"); + return 0; + } + if (!tcp_parse_num(write_tm, write_timeout_ms)) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `write_timeout_ms`; expected NUM"); + return 0; + } + if (!tcp_parse_bool(nodelay_tm, nodelay)) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `nodelay`; expected #T{}|#F{}"); + return 0; + } + if (!tcp_parse_bool(keep_tm, keepalive)) { + *err_out = tcp_new_err("tcp_connect", TCP_ERR_BAD_ARG, "invalid `keepalive`; expected #T{}|#F{}"); + return 0; + } + + return 1; +} + +fn u8 tcp_parse_recv_max(Term max_tm, u32 *max_bytes, Term *err_out) { + if (!tcp_parse_num(max_tm, max_bytes) || *max_bytes == 0 || *max_bytes > TCP_RECV_CAP) { + *err_out = tcp_new_err("tcp_recv", TCP_ERR_BAD_ARG, "invalid `max_bytes`; expected NUM in [1,TCP_RECV_CAP]"); + return 0; + } + return 1; +} + +fn u8 tcp_decode_bytes( + Term bytes_tm, + u8 **buf_out, + u32 *len_out, + u32 max_len, + Term *err_out +) { + Term cur = wnf(bytes_tm); + + u8 *buf = NULL; + u32 len = 0; + u32 cap = 0; + + while (term_tag(cur) == C02 && term_ext(cur) == NAM_CON) { + u32 loc = term_val(cur); + Term head = wnf(heap_read(loc + 0)); + Term tail = heap_read(loc + 1); + + if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#Byt{n}>"); + return 0; + } + + Term num = wnf(heap_read(term_val(head))); + if (term_tag(num) != NUM) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected #Byt{NUM}"); + return 0; + } + + u32 val = term_val(num); + if (val > 255) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; byte must be in [0,255]"); + return 0; + } + + if (len >= max_len) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; payload too large"); + return 0; + } + + if (len == cap) { + u32 next_cap = cap == 0 ? 256 : cap * 2; + if (next_cap > max_len) { + next_cap = max_len; + } + if (next_cap == cap) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; payload too large"); + return 0; + } + + u8 *next = realloc(buf, next_cap); + if (!next) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_IO, "out of memory while decoding bytes"); + return 0; + } + + buf = next; + cap = next_cap; + } + + buf[len] = (u8)val; + len = len + 1; + cur = wnf(tail); + } + + if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + free(buf); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#Byt{n}>"); + return 0; + } + + *buf_out = buf; + *len_out = len; + return 1; +} + +fn Term tcp_bytes_to_list(const u8 *buf, u32 len) { + Term nil = term_new_ctr(NAM_NIL, 0, NULL); + if (len == 0) { + return nil; + } + + Term byt[1] = {term_new_num(buf[0])}; + Term head_tail[2] = {term_new_ctr(NAM_BYT, 1, byt), nil}; + Term out = term_new_ctr(NAM_CON, 2, head_tail); + Term cur = out; + + for (u32 i = 1; i < len; ++i) { + byt[0] = term_new_num(buf[i]); + head_tail[0] = term_new_ctr(NAM_BYT, 1, byt); + heap_set(term_val(cur) + 1, term_new_ctr(NAM_CON, 2, head_tail)); + cur = heap_read(term_val(cur) + 1); + } + + return out; +} + +fn int tcp_poll_retry(struct pollfd *pfd, nfds_t nfd, int timeout_ms) { + while (1) { + int got = poll(pfd, nfd, timeout_ms); + if (got >= 0) { + return got; + } + if (errno == EINTR) { + continue; + } + return -1; + } +} + +fn Term tcp_connect_check_ready(u32 id, u32 seq, int fd) { + int so_err = 0; + socklen_t len = sizeof(so_err); + + if (getsockopt(fd, SOL_SOCKET, SO_ERROR, &so_err, &len) < 0) { + int err = errno; + tcp_slot_close_and_set(id, fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_from_errno_evt("tcp_connect", err))); + } + + if (so_err == 0) { + tcp_slot_set_fd_state(id, fd, TCP_STATE_OPEN); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_conn_evt())); + } + + tcp_slot_close_and_set(id, fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_from_errno_evt("tcp_connect", so_err))); +} + +fn Term tcp_state_not_connected(u32 id, u32 seq) { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_not_connected_evt())); +} + +#include "connect.c" +#include "connect_poll.c" +#include "connect_wait.c" +#include "recv_poll.c" +#include "recv_wait.c" +#include "send_poll.c" +#include "send_wait.c" +#include "close.c" + +fn void prim_tcp_init(void) { + TCP_NAM_TCP = nick_from_str("Tcp", 3); + TCP_NAM_TCP_REQ = nick_from_str("TcpReq", 6); + TCP_NAM_TCP_OPTS = nick_from_str("TcpOpts", 7); + + TCP_NAM_PEND = nick_from_str("Pend", 4); + TCP_NAM_RDY = nick_from_str("Rdy", 3); + TCP_NAM_CONN = nick_from_str("Conn", 4); + TCP_NAM_RECV = nick_from_str("Recv", 4); + TCP_NAM_SENT = nick_from_str("Sent", 4); + TCP_NAM_EOF = nick_from_str("Eof", 3); + TCP_NAM_CLOSED = nick_from_str("Closed", 6); + TCP_NAM_FAIL = nick_from_str("Fail", 4); + + TCP_NAM_TIMEOUT = nick_from_str("Timeout", 7); + TCP_NAM_DNS = nick_from_str("Dns", 3); + TCP_NAM_REFUSED = nick_from_str("Refused", 7); + TCP_NAM_UNREACHABLE = nick_from_str("Unreachable", 11); + TCP_NAM_RESET = nick_from_str("Reset", 5); + TCP_NAM_BROKEN_PIPE = nick_from_str("BrokenPipe", 10); + TCP_NAM_PROTOCOL = nick_from_str("Protocol", 8); + TCP_NAM_NOT_CONNECTED = nick_from_str("NotConnected", 12); + TCP_NAM_SYS = nick_from_str("Sys", 3); + + TCP_NAM_T = nick_from_str("T", 1); + TCP_NAM_F = nick_from_str("F", 1); + + prim_tcp_connect_init(); + prim_tcp_connect_poll_init(); + prim_tcp_connect_wait_init(); + prim_tcp_recv_poll_init(); + prim_tcp_recv_wait_init(); + prim_tcp_send_poll_init(); + prim_tcp_send_wait_init(); + prim_tcp_close_init(); +} diff --git a/clang/prim/fn/tcp/close.c b/clang/prim/fn/tcp/close.c new file mode 100644 index 00000000..665a4e85 --- /dev/null +++ b/clang/prim/fn/tcp/close.c @@ -0,0 +1,102 @@ +// %tcp_close(tcp) +// --------------- +// %tcp_close_go_tcp(tcp) +fn Term prim_fn_tcp_close(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("tcp_close_go_tcp", sizeof("tcp_close_go_tcp") - 1), 1, args0); + return wnf(t); +} + +// %tcp_close_go_tcp(tcp) +// ---------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_close_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_close_go_tcp(&{}) + // ---------------------- tcp-close-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_close_go_tcp(↑x) + // --------------------- tcp-close-go-tcp-inc + // ↑(%tcp_close(x)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("tcp_close", sizeof("tcp_close") - 1), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_close_go_tcp(&L{x,y}) + // -------------------------- tcp-close-go-tcp-sup + // &L{%tcp_close(x), %tcp_close(y)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("tcp_close", sizeof("tcp_close") - 1), 1, &x); + Term t1 = term_new_pri(table_find("tcp_close", sizeof("tcp_close") - 1), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_close_go_tcp(tcp) + // ---------------------- tcp-close-go-tcp-default + // %tcp_close_go_io(tcp) + Term args0[1] = {tcp_wnf}; + Term t = term_new_pri(table_find("tcp_close_go_io", sizeof("tcp_close_go_io") - 1), 1, args0); + return wnf(t); + } + } +} + +// %tcp_close_go_io(tcp) +// --------------------- +// #OK{#Rdy{#Tcp{id,seq+1},#Closed{}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_close_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_close", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_close", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + return tcp_new_err("tcp_close", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_CONNECTING: + case TCP_STATE_OPEN: + case TCP_STATE_REMOTE_EOF: { + if (snap.fd >= 0 && !tcp_close_fd(snap.fd)) { + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_err("tcp_close", TCP_ERR_IO, strerror(errno)); + } + + tcp_slot_set_fd_state(id, -1, TCP_STATE_CLOSED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_closed_evt())); + } + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + return tcp_state_not_connected(id, seq); + } + default: { + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_close_init(void) { + prim_register("tcp_close", sizeof("tcp_close") - 1, 1, prim_fn_tcp_close); + prim_register("tcp_close_go_tcp", sizeof("tcp_close_go_tcp") - 1, 1, tcp_close_go_tcp); + prim_register("tcp_close_go_io", sizeof("tcp_close_go_io") - 1, 1, prim_fn_tcp_close_go_io); +} diff --git a/clang/prim/fn/tcp/connect.c b/clang/prim/fn/tcp/connect.c new file mode 100644 index 00000000..99a39a81 --- /dev/null +++ b/clang/prim/fn/tcp/connect.c @@ -0,0 +1,179 @@ +// %tcp_connect(req) +// ----------------- +// %tcp_connect_go_req(req) +fn Term prim_fn_tcp_connect(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("tcp_connect_go_req", sizeof("tcp_connect_go_req") - 1), 1, args0); + return wnf(t); +} + +// %tcp_connect_go_req(req) +// ------------------------ +// Lift `req` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_connect_go_req(Term *args) { + Term req_wnf = wnf(args[0]); + + switch (term_tag(req_wnf)) { + case ERA: { + // %tcp_connect_go_req(&{}) + // ------------------------ tcp-connect-go-req-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_connect_go_req(↑x) + // ----------------------- tcp-connect-go-req-inc + // ↑(%tcp_connect(x)) + u32 inc_loc = term_val(req_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("tcp_connect", sizeof("tcp_connect") - 1), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_connect_go_req(&L{x,y}) + // ---------------------------- tcp-connect-go-req-sup + // &L{%tcp_connect(x), %tcp_connect(y)} + u32 lab = term_ext(req_wnf); + u32 sup_loc = term_val(req_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("tcp_connect", sizeof("tcp_connect") - 1), 1, &x); + Term t1 = term_new_pri(table_find("tcp_connect", sizeof("tcp_connect") - 1), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_connect_go_req(req) + // ------------------------ tcp-connect-go-req-default + // %tcp_connect_go_io(req) + Term args0[1] = {req_wnf}; + Term t = term_new_pri(table_find("tcp_connect_go_io", sizeof("tcp_connect_go_io") - 1), 1, args0); + return wnf(t); + } + } +} + +// %tcp_connect_go_io(req) +// ----------------------- +// #OK{#Tcp{id,0}} | #ERR{String} +fn Term prim_fn_tcp_connect_go_io(Term *args) { + char host[TCP_HOST_CAP]; + u32 port = 0; + u32 connect_timeout_ms = 0; + u32 read_timeout_ms = 0; + u32 write_timeout_ms = 0; + u8 nodelay = 0; + u8 keepalive = 0; + + Term parse_err = term_new_era(); + if (!tcp_parse_req( + args[0], + host, + &port, + &connect_timeout_ms, + &read_timeout_ms, + &write_timeout_ms, + &nodelay, + &keepalive, + &parse_err + )) { + return parse_err; + } + + char port_str[16]; + snprintf(port_str, sizeof(port_str), "%u", port); + + struct addrinfo hints; + struct addrinfo *res = NULL; + struct addrinfo *it = NULL; + int last_err = 0; + + memset(&hints, 0, sizeof(hints)); + hints.ai_family = AF_UNSPEC; + hints.ai_socktype = SOCK_STREAM; + hints.ai_protocol = IPPROTO_TCP; + + int gai_err = getaddrinfo(host, port_str, &hints, &res); + if (gai_err != 0) { + Term evt = tcp_fail_from_gai_evt("tcp_connect", gai_err); + u32 loc = term_val(evt); + Term msg = heap_read(loc + 1); + return term_new_ctr(NAM_ERR, 1, &msg); + } + + int fd = -1; + u8 state = TCP_STATE_CONNECTING; + + for (it = res; it != NULL; it = it->ai_next) { + fd = socket(it->ai_family, it->ai_socktype, it->ai_protocol); + if (fd < 0) { + last_err = errno; + continue; + } + + if (!tcp_set_nonblocking(fd)) { + last_err = errno; + tcp_close_fd(fd); + fd = -1; + continue; + } + + if (!tcp_apply_sockopts(fd, nodelay, keepalive)) { + last_err = errno; + tcp_close_fd(fd); + fd = -1; + continue; + } + + if (connect(fd, it->ai_addr, it->ai_addrlen) == 0) { + state = TCP_STATE_OPEN; + break; + } + + if (errno == EINPROGRESS || errno == EWOULDBLOCK || errno == EALREADY) { + state = TCP_STATE_CONNECTING; + break; + } + + last_err = errno; + tcp_close_fd(fd); + fd = -1; + } + + freeaddrinfo(res); + + if (fd < 0) { + if (last_err == 0) { + last_err = EIO; + } + return tcp_new_err("tcp_connect", TCP_ERR_IO, strerror(last_err)); + } + + pthread_mutex_lock(&TCP_LOCK); + + u32 id = TCP_NEXT_ID; + if (id >= TCP_CAP) { + pthread_mutex_unlock(&TCP_LOCK); + tcp_close_fd(fd); + return tcp_new_err("tcp_connect", TCP_ERR_FULL, "tcp table is full"); + } + + TCP_NEXT_ID = id + 1; + TcpSlot *slot = &TCP_SLOTS[id]; + slot->expected_seq = 0; + slot->fd = fd; + slot->state = state; + slot->connect_timeout_ms = connect_timeout_ms; + slot->read_timeout_ms = read_timeout_ms; + slot->write_timeout_ms = write_timeout_ms; + slot->connect_start_ms = tcp_now_ms(); + + pthread_mutex_unlock(&TCP_LOCK); + return tcp_new_ok(tcp_new_tcp(id, 0)); +} + +fn void prim_tcp_connect_init(void) { + prim_register("tcp_connect", sizeof("tcp_connect") - 1, 1, prim_fn_tcp_connect); + prim_register("tcp_connect_go_req", sizeof("tcp_connect_go_req") - 1, 1, tcp_connect_go_req); + prim_register("tcp_connect_go_io", sizeof("tcp_connect_go_io") - 1, 1, prim_fn_tcp_connect_go_io); +} diff --git a/clang/prim/fn/tcp/connect_poll.c b/clang/prim/fn/tcp/connect_poll.c new file mode 100644 index 00000000..ce8c4e2d --- /dev/null +++ b/clang/prim/fn/tcp/connect_poll.c @@ -0,0 +1,121 @@ +// %tcp_connect_poll(tcp) +// ---------------------- +// %tcp_connect_poll_go_tcp(tcp) +fn Term prim_fn_tcp_connect_poll(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("tcp_connect_poll_go_tcp", sizeof("tcp_connect_poll_go_tcp") - 1), 1, args0); + return wnf(t); +} + +// %tcp_connect_poll_go_tcp(tcp) +// ----------------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_connect_poll_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_connect_poll_go_tcp(&{}) + // ----------------------------- tcp-connect-poll-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_connect_poll_go_tcp(↑x) + // ---------------------------- tcp-connect-poll-go-tcp-inc + // ↑(%tcp_connect_poll(x)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("tcp_connect_poll", sizeof("tcp_connect_poll") - 1), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_connect_poll_go_tcp(&L{x,y}) + // --------------------------------- tcp-connect-poll-go-tcp-sup + // &L{%tcp_connect_poll(x), %tcp_connect_poll(y)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("tcp_connect_poll", sizeof("tcp_connect_poll") - 1), 1, &x); + Term t1 = term_new_pri(table_find("tcp_connect_poll", sizeof("tcp_connect_poll") - 1), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_connect_poll_go_tcp(tcp) + // ----------------------------- tcp-connect-poll-go-tcp-default + // %tcp_connect_poll_go_io(tcp) + Term args0[1] = {tcp_wnf}; + Term t = term_new_pri(table_find("tcp_connect_poll_go_io", sizeof("tcp_connect_poll_go_io") - 1), 1, args0); + return wnf(t); + } + } +} + +// %tcp_connect_poll_go_io(tcp) +// ---------------------------- +// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Conn{}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_connect_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_connect_poll", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_connect_poll", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + return tcp_new_err("tcp_connect_poll", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_OPEN: + case TCP_STATE_REMOTE_EOF: { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_conn_evt())); + } + case TCP_STATE_CONNECTING: { + if (snap.fd < 0) { + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid connecting socket"))); + } + + if (snap.connect_timeout_ms != 0 && tcp_timeout_to_poll_ms(snap.connect_start_ms, snap.connect_timeout_ms) == 0) { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_connect"))); + } + + struct pollfd pfd = { + .fd = snap.fd, + .events = POLLOUT | POLLERR | POLLHUP, + .revents = 0, + }; + + int got = tcp_poll_retry(&pfd, 1, 0); + if (got < 0) { + return tcp_new_err("tcp_connect_poll", TCP_ERR_IO, strerror(errno)); + } + if (got == 0) { + return tcp_new_ok(tcp_new_pend(id, seq + 1)); + } + + return tcp_connect_check_ready(id, seq, snap.fd); + } + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + return tcp_state_not_connected(id, seq); + } + default: { + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_connect_poll_init(void) { + prim_register("tcp_connect_poll", sizeof("tcp_connect_poll") - 1, 1, prim_fn_tcp_connect_poll); + prim_register("tcp_connect_poll_go_tcp", sizeof("tcp_connect_poll_go_tcp") - 1, 1, tcp_connect_poll_go_tcp); + prim_register("tcp_connect_poll_go_io", sizeof("tcp_connect_poll_go_io") - 1, 1, prim_fn_tcp_connect_poll_go_io); +} diff --git a/clang/prim/fn/tcp/connect_wait.c b/clang/prim/fn/tcp/connect_wait.c new file mode 100644 index 00000000..105e5ebf --- /dev/null +++ b/clang/prim/fn/tcp/connect_wait.c @@ -0,0 +1,122 @@ +// %tcp_connect_wait(tcp) +// ---------------------- +// %tcp_connect_wait_go_tcp(tcp) +fn Term prim_fn_tcp_connect_wait(Term *args) { + Term args0[1] = {args[0]}; + Term t = term_new_pri(table_find("tcp_connect_wait_go_tcp", sizeof("tcp_connect_wait_go_tcp") - 1), 1, args0); + return wnf(t); +} + +// %tcp_connect_wait_go_tcp(tcp) +// ----------------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_connect_wait_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_connect_wait_go_tcp(&{}) + // ----------------------------- tcp-connect-wait-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_connect_wait_go_tcp(↑x) + // ---------------------------- tcp-connect-wait-go-tcp-inc + // ↑(%tcp_connect_wait(x)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term next = term_new_pri(table_find("tcp_connect_wait", sizeof("tcp_connect_wait") - 1), 1, &inner); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_connect_wait_go_tcp(&L{x,y}) + // --------------------------------- tcp-connect-wait-go-tcp-sup + // &L{%tcp_connect_wait(x), %tcp_connect_wait(y)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Term t0 = term_new_pri(table_find("tcp_connect_wait", sizeof("tcp_connect_wait") - 1), 1, &x); + Term t1 = term_new_pri(table_find("tcp_connect_wait", sizeof("tcp_connect_wait") - 1), 1, &y); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_connect_wait_go_tcp(tcp) + // ----------------------------- tcp-connect-wait-go-tcp-default + // %tcp_connect_wait_go_io(tcp) + Term args0[1] = {tcp_wnf}; + Term t = term_new_pri(table_find("tcp_connect_wait_go_io", sizeof("tcp_connect_wait_go_io") - 1), 1, args0); + return wnf(t); + } + } +} + +// %tcp_connect_wait_go_io(tcp) +// ---------------------------- +// #OK{#Rdy{#Tcp{id,seq+1},#Conn{}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_connect_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_connect_wait", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_connect_wait", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + return tcp_new_err("tcp_connect_wait", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_OPEN: + case TCP_STATE_REMOTE_EOF: { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_conn_evt())); + } + case TCP_STATE_CONNECTING: { + if (snap.fd < 0) { + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid connecting socket"))); + } + + int timeout_ms = tcp_timeout_to_poll_ms(snap.connect_start_ms, snap.connect_timeout_ms); + if (timeout_ms == 0) { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_connect"))); + } + + struct pollfd pfd = { + .fd = snap.fd, + .events = POLLOUT | POLLERR | POLLHUP, + .revents = 0, + }; + + int got = tcp_poll_retry(&pfd, 1, timeout_ms); + if (got < 0) { + return tcp_new_err("tcp_connect_wait", TCP_ERR_IO, strerror(errno)); + } + if (got == 0) { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_connect"))); + } + + return tcp_connect_check_ready(id, seq, snap.fd); + } + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + return tcp_state_not_connected(id, seq); + } + default: { + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_connect_wait_init(void) { + prim_register("tcp_connect_wait", sizeof("tcp_connect_wait") - 1, 1, prim_fn_tcp_connect_wait); + prim_register("tcp_connect_wait_go_tcp", sizeof("tcp_connect_wait_go_tcp") - 1, 1, tcp_connect_wait_go_tcp); + prim_register("tcp_connect_wait_go_io", sizeof("tcp_connect_wait_go_io") - 1, 1, prim_fn_tcp_connect_wait_go_io); +} diff --git a/clang/prim/fn/tcp/recv_poll.c b/clang/prim/fn/tcp/recv_poll.c new file mode 100644 index 00000000..30bf480d --- /dev/null +++ b/clang/prim/fn/tcp/recv_poll.c @@ -0,0 +1,198 @@ +// %tcp_recv_poll(tcp, max_bytes) +// ------------------------------ +// %tcp_recv_poll_go_tcp(tcp, max_bytes) +fn Term prim_fn_tcp_recv_poll(Term *args) { + Term args0[2] = {args[0], args[1]}; + Term t = term_new_pri(table_find("tcp_recv_poll_go_tcp", sizeof("tcp_recv_poll_go_tcp") - 1), 2, args0); + return wnf(t); +} + +// %tcp_recv_poll_go_tcp(tcp, max_bytes) +// ------------------------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to max stage. +fn Term tcp_recv_poll_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + Term max_bytes = args[1]; + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_recv_poll_go_tcp(&{}, max_bytes) + // ------------------------------------- tcp-recv-poll-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_recv_poll_go_tcp(↑x, max_bytes) + // ------------------------------------ tcp-recv-poll-go-tcp-inc + // ↑(%tcp_recv_poll(x, max_bytes)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {inner, max_bytes}; + Term next = term_new_pri(table_find("tcp_recv_poll", sizeof("tcp_recv_poll") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_recv_poll_go_tcp(&L{x,y}, max_bytes) + // ----------------------------------------- tcp-recv-poll-go-tcp-sup + // &L{%tcp_recv_poll(x, max0), %tcp_recv_poll(y, max1)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy M = term_clone(lab, max_bytes); + Term a0[2] = {x, M.k0}; + Term a1[2] = {y, M.k1}; + Term t0 = term_new_pri(table_find("tcp_recv_poll", sizeof("tcp_recv_poll") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_recv_poll", sizeof("tcp_recv_poll") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_recv_poll_go_tcp(tcp, max_bytes) + // ------------------------------------- tcp-recv-poll-go-tcp-default + // %tcp_recv_poll_go_max(tcp, max_bytes) + Term args0[2] = {tcp_wnf, max_bytes}; + Term t = term_new_pri(table_find("tcp_recv_poll_go_max", sizeof("tcp_recv_poll_go_max") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_recv_poll_go_max(tcp, max_bytes) +// ------------------------------------- +// Lift `max_bytes` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_recv_poll_go_max(Term *args) { + Term tcp = args[0]; + Term max_wnf = wnf(args[1]); + + switch (term_tag(max_wnf)) { + case ERA: { + // %tcp_recv_poll_go_max(tcp, &{}) + // ------------------------------- tcp-recv-poll-go-max-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_recv_poll_go_max(tcp, ↑x) + // ------------------------------ tcp-recv-poll-go-max-inc + // ↑(%tcp_recv_poll(tcp, x)) + u32 inc_loc = term_val(max_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {tcp, inner}; + Term next = term_new_pri(table_find("tcp_recv_poll", sizeof("tcp_recv_poll") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_recv_poll_go_max(tcp, &L{x,y}) + // ------------------------------------ tcp-recv-poll-go-max-sup + // &L{%tcp_recv_poll(tcp0, x), %tcp_recv_poll(tcp1, y)} + u32 lab = term_ext(max_wnf); + u32 sup_loc = term_val(max_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy T = term_clone(lab, tcp); + Term a0[2] = {T.k0, x}; + Term a1[2] = {T.k1, y}; + Term t0 = term_new_pri(table_find("tcp_recv_poll", sizeof("tcp_recv_poll") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_recv_poll", sizeof("tcp_recv_poll") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_recv_poll_go_max(tcp, max_bytes) + // ------------------------------------- tcp-recv-poll-go-max-default + // %tcp_recv_poll_go_io(tcp, max_bytes) + Term args0[2] = {tcp, max_wnf}; + Term t = term_new_pri(table_find("tcp_recv_poll_go_io", sizeof("tcp_recv_poll_go_io") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_recv_poll_go_io(tcp, max_bytes) +// ------------------------------------ +// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Recv{bytes}|#Eof{}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_recv_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_recv_poll", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_recv_poll", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + Term err = term_new_era(); + u32 max_bytes = 0; + if (!tcp_parse_recv_max(args[1], &max_bytes, &err)) { + return err; + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + return tcp_new_err("tcp_recv_poll", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_REMOTE_EOF: { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_eof_evt())); + } + case TCP_STATE_OPEN: { + if (snap.fd < 0) { + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_not_connected_evt())); + } + + u8 *buf = malloc(max_bytes); + if (!buf) { + return tcp_new_err("tcp_recv_poll", TCP_ERR_IO, "out of memory"); + } + + while (1) { + ssize_t got = recv(snap.fd, buf, max_bytes, 0); + if (got > 0) { + Term bytes = tcp_bytes_to_list(buf, (u32)got); + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_recv_evt(bytes))); + } + + if (got == 0) { + free(buf); + tcp_slot_set_fd_state(id, snap.fd, TCP_STATE_REMOTE_EOF); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_eof_evt())); + } + + if (errno == EINTR) { + continue; + } + + if (errno == EAGAIN || errno == EWOULDBLOCK) { + free(buf); + return tcp_new_ok(tcp_new_pend(id, seq + 1)); + } + + int errn = errno; + free(buf); + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_from_errno_evt("tcp_recv", errn))); + } + } + case TCP_STATE_CONNECTING: + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + return tcp_state_not_connected(id, seq); + } + default: { + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_recv_poll_init(void) { + prim_register("tcp_recv_poll", sizeof("tcp_recv_poll") - 1, 2, prim_fn_tcp_recv_poll); + prim_register("tcp_recv_poll_go_tcp", sizeof("tcp_recv_poll_go_tcp") - 1, 2, tcp_recv_poll_go_tcp); + prim_register("tcp_recv_poll_go_max", sizeof("tcp_recv_poll_go_max") - 1, 2, tcp_recv_poll_go_max); + prim_register("tcp_recv_poll_go_io", sizeof("tcp_recv_poll_go_io") - 1, 2, prim_fn_tcp_recv_poll_go_io); +} diff --git a/clang/prim/fn/tcp/recv_wait.c b/clang/prim/fn/tcp/recv_wait.c new file mode 100644 index 00000000..c6c57cea --- /dev/null +++ b/clang/prim/fn/tcp/recv_wait.c @@ -0,0 +1,220 @@ +// %tcp_recv_wait(tcp, max_bytes) +// ------------------------------ +// %tcp_recv_wait_go_tcp(tcp, max_bytes) +fn Term prim_fn_tcp_recv_wait(Term *args) { + Term args0[2] = {args[0], args[1]}; + Term t = term_new_pri(table_find("tcp_recv_wait_go_tcp", sizeof("tcp_recv_wait_go_tcp") - 1), 2, args0); + return wnf(t); +} + +// %tcp_recv_wait_go_tcp(tcp, max_bytes) +// ------------------------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to max stage. +fn Term tcp_recv_wait_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + Term max_bytes = args[1]; + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_recv_wait_go_tcp(&{}, max_bytes) + // ------------------------------------- tcp-recv-wait-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_recv_wait_go_tcp(↑x, max_bytes) + // ------------------------------------ tcp-recv-wait-go-tcp-inc + // ↑(%tcp_recv_wait(x, max_bytes)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {inner, max_bytes}; + Term next = term_new_pri(table_find("tcp_recv_wait", sizeof("tcp_recv_wait") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_recv_wait_go_tcp(&L{x,y}, max_bytes) + // ----------------------------------------- tcp-recv-wait-go-tcp-sup + // &L{%tcp_recv_wait(x, max0), %tcp_recv_wait(y, max1)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy M = term_clone(lab, max_bytes); + Term a0[2] = {x, M.k0}; + Term a1[2] = {y, M.k1}; + Term t0 = term_new_pri(table_find("tcp_recv_wait", sizeof("tcp_recv_wait") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_recv_wait", sizeof("tcp_recv_wait") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_recv_wait_go_tcp(tcp, max_bytes) + // ------------------------------------- tcp-recv-wait-go-tcp-default + // %tcp_recv_wait_go_max(tcp, max_bytes) + Term args0[2] = {tcp_wnf, max_bytes}; + Term t = term_new_pri(table_find("tcp_recv_wait_go_max", sizeof("tcp_recv_wait_go_max") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_recv_wait_go_max(tcp, max_bytes) +// ------------------------------------- +// Lift `max_bytes` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_recv_wait_go_max(Term *args) { + Term tcp = args[0]; + Term max_wnf = wnf(args[1]); + + switch (term_tag(max_wnf)) { + case ERA: { + // %tcp_recv_wait_go_max(tcp, &{}) + // ------------------------------- tcp-recv-wait-go-max-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_recv_wait_go_max(tcp, ↑x) + // ------------------------------ tcp-recv-wait-go-max-inc + // ↑(%tcp_recv_wait(tcp, x)) + u32 inc_loc = term_val(max_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {tcp, inner}; + Term next = term_new_pri(table_find("tcp_recv_wait", sizeof("tcp_recv_wait") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_recv_wait_go_max(tcp, &L{x,y}) + // ----------------------------------- tcp-recv-wait-go-max-sup + // &L{%tcp_recv_wait(tcp0, x), %tcp_recv_wait(tcp1, y)} + u32 lab = term_ext(max_wnf); + u32 sup_loc = term_val(max_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy T = term_clone(lab, tcp); + Term a0[2] = {T.k0, x}; + Term a1[2] = {T.k1, y}; + Term t0 = term_new_pri(table_find("tcp_recv_wait", sizeof("tcp_recv_wait") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_recv_wait", sizeof("tcp_recv_wait") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_recv_wait_go_max(tcp, max_bytes) + // ------------------------------------- tcp-recv-wait-go-max-default + // %tcp_recv_wait_go_io(tcp, max_bytes) + Term args0[2] = {tcp, max_wnf}; + Term t = term_new_pri(table_find("tcp_recv_wait_go_io", sizeof("tcp_recv_wait_go_io") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_recv_wait_go_io(tcp, max_bytes) +// ------------------------------------ +// #OK{#Rdy{#Tcp{id,seq+1},#Recv{bytes}|#Eof{}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_recv_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_recv_wait", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_recv_wait", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + Term err = term_new_era(); + u32 max_bytes = 0; + if (!tcp_parse_recv_max(args[1], &max_bytes, &err)) { + return err; + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + return tcp_new_err("tcp_recv_wait", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_REMOTE_EOF: { + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_eof_evt())); + } + case TCP_STATE_OPEN: { + if (snap.fd < 0) { + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_not_connected_evt())); + } + + u8 *buf = malloc(max_bytes); + if (!buf) { + return tcp_new_err("tcp_recv_wait", TCP_ERR_IO, "out of memory"); + } + + u64 wait_start_ms = tcp_now_ms(); + + while (1) { + ssize_t got = recv(snap.fd, buf, max_bytes, 0); + if (got > 0) { + Term bytes = tcp_bytes_to_list(buf, (u32)got); + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_recv_evt(bytes))); + } + + if (got == 0) { + free(buf); + tcp_slot_set_fd_state(id, snap.fd, TCP_STATE_REMOTE_EOF); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_eof_evt())); + } + + if (errno == EINTR) { + continue; + } + + if (errno == EAGAIN || errno == EWOULDBLOCK) { + int timeout_ms = tcp_timeout_to_poll_ms(wait_start_ms, snap.read_timeout_ms); + if (timeout_ms == 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_recv"))); + } + + struct pollfd pfd = { + .fd = snap.fd, + .events = POLLIN | POLLERR | POLLHUP, + .revents = 0, + }; + + int polled = tcp_poll_retry(&pfd, 1, timeout_ms); + if (polled < 0) { + free(buf); + return tcp_new_err("tcp_recv_wait", TCP_ERR_IO, strerror(errno)); + } + if (polled == 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_recv"))); + } + continue; + } + + int errn = errno; + free(buf); + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_from_errno_evt("tcp_recv", errn))); + } + } + case TCP_STATE_CONNECTING: + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + return tcp_state_not_connected(id, seq); + } + default: { + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_recv_wait_init(void) { + prim_register("tcp_recv_wait", sizeof("tcp_recv_wait") - 1, 2, prim_fn_tcp_recv_wait); + prim_register("tcp_recv_wait_go_tcp", sizeof("tcp_recv_wait_go_tcp") - 1, 2, tcp_recv_wait_go_tcp); + prim_register("tcp_recv_wait_go_max", sizeof("tcp_recv_wait_go_max") - 1, 2, tcp_recv_wait_go_max); + prim_register("tcp_recv_wait_go_io", sizeof("tcp_recv_wait_go_io") - 1, 2, prim_fn_tcp_recv_wait_go_io); +} diff --git a/clang/prim/fn/tcp/send_poll.c b/clang/prim/fn/tcp/send_poll.c new file mode 100644 index 00000000..9570d70b --- /dev/null +++ b/clang/prim/fn/tcp/send_poll.c @@ -0,0 +1,194 @@ +// %tcp_send_poll(tcp, bytes) +// -------------------------- +// %tcp_send_poll_go_tcp(tcp, bytes) +fn Term prim_fn_tcp_send_poll(Term *args) { + Term args0[2] = {args[0], args[1]}; + Term t = term_new_pri(table_find("tcp_send_poll_go_tcp", sizeof("tcp_send_poll_go_tcp") - 1), 2, args0); + return wnf(t); +} + +// %tcp_send_poll_go_tcp(tcp, bytes) +// --------------------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to bytes stage. +fn Term tcp_send_poll_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + Term bytes = args[1]; + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_send_poll_go_tcp(&{}, bytes) + // --------------------------------- tcp-send-poll-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_send_poll_go_tcp(↑x, bytes) + // -------------------------------- tcp-send-poll-go-tcp-inc + // ↑(%tcp_send_poll(x, bytes)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {inner, bytes}; + Term next = term_new_pri(table_find("tcp_send_poll", sizeof("tcp_send_poll") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_send_poll_go_tcp(&L{x,y}, bytes) + // ------------------------------------- tcp-send-poll-go-tcp-sup + // &L{%tcp_send_poll(x, bytes0), %tcp_send_poll(y, bytes1)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy B = term_clone(lab, bytes); + Term a0[2] = {x, B.k0}; + Term a1[2] = {y, B.k1}; + Term t0 = term_new_pri(table_find("tcp_send_poll", sizeof("tcp_send_poll") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_send_poll", sizeof("tcp_send_poll") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_send_poll_go_tcp(tcp, bytes) + // --------------------------------- tcp-send-poll-go-tcp-default + // %tcp_send_poll_go_bytes(tcp, bytes) + Term args0[2] = {tcp_wnf, bytes}; + Term t = term_new_pri(table_find("tcp_send_poll_go_bytes", sizeof("tcp_send_poll_go_bytes") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_send_poll_go_bytes(tcp, bytes) +// ----------------------------------- +// Lift `bytes` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_send_poll_go_bytes(Term *args) { + Term tcp = args[0]; + Term bytes_wnf = wnf(args[1]); + + switch (term_tag(bytes_wnf)) { + case ERA: { + // %tcp_send_poll_go_bytes(tcp, &{}) + // --------------------------------- tcp-send-poll-go-bytes-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_send_poll_go_bytes(tcp, ↑x) + // -------------------------------- tcp-send-poll-go-bytes-inc + // ↑(%tcp_send_poll(tcp, x)) + u32 inc_loc = term_val(bytes_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {tcp, inner}; + Term next = term_new_pri(table_find("tcp_send_poll", sizeof("tcp_send_poll") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_send_poll_go_bytes(tcp, &L{x,y}) + // ------------------------------------- tcp-send-poll-go-bytes-sup + // &L{%tcp_send_poll(tcp0, x), %tcp_send_poll(tcp1, y)} + u32 lab = term_ext(bytes_wnf); + u32 sup_loc = term_val(bytes_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy T = term_clone(lab, tcp); + Term a0[2] = {T.k0, x}; + Term a1[2] = {T.k1, y}; + Term t0 = term_new_pri(table_find("tcp_send_poll", sizeof("tcp_send_poll") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_send_poll", sizeof("tcp_send_poll") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_send_poll_go_bytes(tcp, bytes) + // ----------------------------------- tcp-send-poll-go-bytes-default + // %tcp_send_poll_go_io(tcp, bytes) + Term args0[2] = {tcp, bytes_wnf}; + Term t = term_new_pri(table_find("tcp_send_poll_go_io", sizeof("tcp_send_poll_go_io") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_send_poll_go_io(tcp, bytes) +// -------------------------------- +// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Sent{n}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_send_poll_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_send_poll", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_send_poll", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + Term err = term_new_era(); + u8 *buf = NULL; + u32 len = 0; + if (!tcp_decode_bytes(args[1], &buf, &len, TCP_SEND_CAP, &err)) { + return err; + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + free(buf); + return tcp_new_err("tcp_send_poll", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_OPEN: + case TCP_STATE_REMOTE_EOF: { + if (snap.fd < 0) { + free(buf); + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_not_connected_evt())); + } + + if (len == 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_sent_evt(0))); + } + + while (1) { + ssize_t sent = send(snap.fd, buf, len, MSG_NOSIGNAL); + if (sent >= 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_sent_evt((u32)sent))); + } + + if (errno == EINTR) { + continue; + } + + if (errno == EAGAIN || errno == EWOULDBLOCK) { + free(buf); + return tcp_new_ok(tcp_new_pend(id, seq + 1)); + } + + int errn = errno; + free(buf); + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_from_errno_evt("tcp_send", errn))); + } + } + case TCP_STATE_CONNECTING: + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + free(buf); + return tcp_state_not_connected(id, seq); + } + default: { + free(buf); + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_send_poll_init(void) { + prim_register("tcp_send_poll", sizeof("tcp_send_poll") - 1, 2, prim_fn_tcp_send_poll); + prim_register("tcp_send_poll_go_tcp", sizeof("tcp_send_poll_go_tcp") - 1, 2, tcp_send_poll_go_tcp); + prim_register("tcp_send_poll_go_bytes", sizeof("tcp_send_poll_go_bytes") - 1, 2, tcp_send_poll_go_bytes); + prim_register("tcp_send_poll_go_io", sizeof("tcp_send_poll_go_io") - 1, 2, prim_fn_tcp_send_poll_go_io); +} diff --git a/clang/prim/fn/tcp/send_wait.c b/clang/prim/fn/tcp/send_wait.c new file mode 100644 index 00000000..c6114bbb --- /dev/null +++ b/clang/prim/fn/tcp/send_wait.c @@ -0,0 +1,216 @@ +// %tcp_send_wait(tcp, bytes) +// -------------------------- +// %tcp_send_wait_go_tcp(tcp, bytes) +fn Term prim_fn_tcp_send_wait(Term *args) { + Term args0[2] = {args[0], args[1]}; + Term t = term_new_pri(table_find("tcp_send_wait_go_tcp", sizeof("tcp_send_wait_go_tcp") - 1), 2, args0); + return wnf(t); +} + +// %tcp_send_wait_go_tcp(tcp, bytes) +// --------------------------------- +// Lift `tcp` over ERA/INC/SUP; default forwards to bytes stage. +fn Term tcp_send_wait_go_tcp(Term *args) { + Term tcp_wnf = wnf(args[0]); + Term bytes = args[1]; + + switch (term_tag(tcp_wnf)) { + case ERA: { + // %tcp_send_wait_go_tcp(&{}, bytes) + // --------------------------------- tcp-send-wait-go-tcp-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_send_wait_go_tcp(↑x, bytes) + // -------------------------------- tcp-send-wait-go-tcp-inc + // ↑(%tcp_send_wait(x, bytes)) + u32 inc_loc = term_val(tcp_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {inner, bytes}; + Term next = term_new_pri(table_find("tcp_send_wait", sizeof("tcp_send_wait") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_send_wait_go_tcp(&L{x,y}, bytes) + // ------------------------------------- tcp-send-wait-go-tcp-sup + // &L{%tcp_send_wait(x, bytes0), %tcp_send_wait(y, bytes1)} + u32 lab = term_ext(tcp_wnf); + u32 sup_loc = term_val(tcp_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy B = term_clone(lab, bytes); + Term a0[2] = {x, B.k0}; + Term a1[2] = {y, B.k1}; + Term t0 = term_new_pri(table_find("tcp_send_wait", sizeof("tcp_send_wait") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_send_wait", sizeof("tcp_send_wait") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_send_wait_go_tcp(tcp, bytes) + // --------------------------------- tcp-send-wait-go-tcp-default + // %tcp_send_wait_go_bytes(tcp, bytes) + Term args0[2] = {tcp_wnf, bytes}; + Term t = term_new_pri(table_find("tcp_send_wait_go_bytes", sizeof("tcp_send_wait_go_bytes") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_send_wait_go_bytes(tcp, bytes) +// ----------------------------------- +// Lift `bytes` over ERA/INC/SUP; default forwards to io stage. +fn Term tcp_send_wait_go_bytes(Term *args) { + Term tcp = args[0]; + Term bytes_wnf = wnf(args[1]); + + switch (term_tag(bytes_wnf)) { + case ERA: { + // %tcp_send_wait_go_bytes(tcp, &{}) + // --------------------------------- tcp-send-wait-go-bytes-era + // &{} + return term_new_era(); + } + case INC: { + // %tcp_send_wait_go_bytes(tcp, ↑x) + // -------------------------------- tcp-send-wait-go-bytes-inc + // ↑(%tcp_send_wait(tcp, x)) + u32 inc_loc = term_val(bytes_wnf); + Term inner = heap_read(inc_loc); + Term args0[2] = {tcp, inner}; + Term next = term_new_pri(table_find("tcp_send_wait", sizeof("tcp_send_wait") - 1), 2, args0); + heap_set(inc_loc, next); + return term_new(0, INC, 0, inc_loc); + } + case SUP: { + // %tcp_send_wait_go_bytes(tcp, &L{x,y}) + // ------------------------------------- tcp-send-wait-go-bytes-sup + // &L{%tcp_send_wait(tcp0, x), %tcp_send_wait(tcp1, y)} + u32 lab = term_ext(bytes_wnf); + u32 sup_loc = term_val(bytes_wnf); + Term x = heap_read(sup_loc + 0); + Term y = heap_read(sup_loc + 1); + Copy T = term_clone(lab, tcp); + Term a0[2] = {T.k0, x}; + Term a1[2] = {T.k1, y}; + Term t0 = term_new_pri(table_find("tcp_send_wait", sizeof("tcp_send_wait") - 1), 2, a0); + Term t1 = term_new_pri(table_find("tcp_send_wait", sizeof("tcp_send_wait") - 1), 2, a1); + return term_new_sup(lab, t0, t1); + } + default: { + // %tcp_send_wait_go_bytes(tcp, bytes) + // ----------------------------------- tcp-send-wait-go-bytes-default + // %tcp_send_wait_go_io(tcp, bytes) + Term args0[2] = {tcp, bytes_wnf}; + Term t = term_new_pri(table_find("tcp_send_wait_go_io", sizeof("tcp_send_wait_go_io") - 1), 2, args0); + return wnf(t); + } + } +} + +// %tcp_send_wait_go_io(tcp, bytes) +// -------------------------------- +// #OK{#Rdy{#Tcp{id,seq+1},#Sent{n}|#Fail{reason,msg}}} | #ERR{String} +fn Term prim_fn_tcp_send_wait_go_io(Term *args) { + u32 id = 0; + u32 seq = 0; + if (!tcp_parse_handle(args[0], &id, &seq)) { + return tcp_new_err("tcp_send_wait", TCP_ERR_BAD_HANDLE, "invalid `tcp`; expected #Tcp{id,seq}"); + } + + if (!tcp_is_valid_id(id)) { + return tcp_new_err("tcp_send_wait", TCP_ERR_BAD_HANDLE, "unknown tcp id"); + } + + Term err = term_new_era(); + u8 *buf = NULL; + u32 len = 0; + if (!tcp_decode_bytes(args[1], &buf, &len, TCP_SEND_CAP, &err)) { + return err; + } + + TcpSnap snap; + if (!tcp_claim(id, seq, &snap)) { + free(buf); + return tcp_new_err("tcp_send_wait", TCP_ERR_STALE, "stale tcp handle"); + } + + switch (snap.state) { + case TCP_STATE_OPEN: + case TCP_STATE_REMOTE_EOF: { + if (snap.fd < 0) { + free(buf); + tcp_slot_set_fd_state(id, -1, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_not_connected_evt())); + } + + if (len == 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_sent_evt(0))); + } + + u64 wait_start_ms = tcp_now_ms(); + + while (1) { + ssize_t sent = send(snap.fd, buf, len, MSG_NOSIGNAL); + if (sent >= 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_new_sent_evt((u32)sent))); + } + + if (errno == EINTR) { + continue; + } + + if (errno == EAGAIN || errno == EWOULDBLOCK) { + int timeout_ms = tcp_timeout_to_poll_ms(wait_start_ms, snap.write_timeout_ms); + if (timeout_ms == 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_send"))); + } + + struct pollfd pfd = { + .fd = snap.fd, + .events = POLLOUT | POLLERR | POLLHUP, + .revents = 0, + }; + + int polled = tcp_poll_retry(&pfd, 1, timeout_ms); + if (polled < 0) { + free(buf); + return tcp_new_err("tcp_send_wait", TCP_ERR_IO, strerror(errno)); + } + if (polled == 0) { + free(buf); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_timeout_evt("tcp_send"))); + } + continue; + } + + int errn = errno; + free(buf); + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_from_errno_evt("tcp_send", errn))); + } + } + case TCP_STATE_CONNECTING: + case TCP_STATE_CLOSED: + case TCP_STATE_FAILED: { + free(buf); + return tcp_state_not_connected(id, seq); + } + default: { + free(buf); + tcp_slot_close_and_set(id, snap.fd, TCP_STATE_FAILED); + return tcp_new_ok(tcp_new_rdy(id, seq + 1, tcp_fail_evt(TCP_FAIL_PROTOCOL, 0, "invalid tcp state"))); + } + } +} + +fn void prim_tcp_send_wait_init(void) { + prim_register("tcp_send_wait", sizeof("tcp_send_wait") - 1, 2, prim_fn_tcp_send_wait); + prim_register("tcp_send_wait_go_tcp", sizeof("tcp_send_wait_go_tcp") - 1, 2, tcp_send_wait_go_tcp); + prim_register("tcp_send_wait_go_bytes", sizeof("tcp_send_wait_go_bytes") - 1, 2, tcp_send_wait_go_bytes); + prim_register("tcp_send_wait_go_io", sizeof("tcp_send_wait_go_io") - 1, 2, prim_fn_tcp_send_wait_go_io); +} From 94b6c694bf539891f0b7c8c28de02d3cbbfc5c65 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Wed, 11 Feb 2026 07:39:42 -0300 Subject: [PATCH 25/35] init, docs and tests --- clang/hvm.c | 3 ++- clang/prim/init.c | 3 ++- docs/hvm/core.md | 16 +++++++++---- docs/hvm/syntax.md | 27 ++++++++++++++++++---- test/prim_http_cancel_bad_handle.hvm4 | 2 ++ test/prim_http_poll_bad_handle.hvm4 | 2 ++ test/prim_http_request_bad_arg.hvm4 | 2 ++ test/prim_http_wait_era.hvm4 | 2 ++ test/prim_https_cancel_bad_handle.hvm4 | 2 -- test/prim_https_get_bad_arg.hvm4 | 2 -- test/prim_https_poll_bad_handle.hvm4 | 2 -- test/prim_https_wait_era.hvm4 | 2 -- test/prim_tcp_close_bad_handle.hvm4 | 2 ++ test/prim_tcp_close_era.hvm4 | 2 ++ test/prim_tcp_connect_bad_arg.hvm4 | 2 ++ test/prim_tcp_connect_poll_bad_handle.hvm4 | 2 ++ test/prim_tcp_connect_wait_era.hvm4 | 2 ++ test/prim_tcp_recv_poll_bad_handle.hvm4 | 2 ++ test/prim_tcp_recv_wait_era_arg.hvm4 | 2 ++ test/prim_tcp_send_poll_bad_handle.hvm4 | 2 ++ test/prim_tcp_send_wait_era_arg.hvm4 | 2 ++ 21 files changed, 65 insertions(+), 18 deletions(-) create mode 100644 test/prim_http_cancel_bad_handle.hvm4 create mode 100644 test/prim_http_poll_bad_handle.hvm4 create mode 100644 test/prim_http_request_bad_arg.hvm4 create mode 100644 test/prim_http_wait_era.hvm4 delete mode 100644 test/prim_https_cancel_bad_handle.hvm4 delete mode 100644 test/prim_https_get_bad_arg.hvm4 delete mode 100644 test/prim_https_poll_bad_handle.hvm4 delete mode 100644 test/prim_https_wait_era.hvm4 create mode 100644 test/prim_tcp_close_bad_handle.hvm4 create mode 100644 test/prim_tcp_close_era.hvm4 create mode 100644 test/prim_tcp_connect_bad_arg.hvm4 create mode 100644 test/prim_tcp_connect_poll_bad_handle.hvm4 create mode 100644 test/prim_tcp_connect_wait_era.hvm4 create mode 100644 test/prim_tcp_recv_poll_bad_handle.hvm4 create mode 100644 test/prim_tcp_recv_wait_era_arg.hvm4 create mode 100644 test/prim_tcp_send_poll_bad_handle.hvm4 create mode 100644 test/prim_tcp_send_wait_era_arg.hvm4 diff --git a/clang/hvm.c b/clang/hvm.c index de352b6a..b4eb31d6 100644 --- a/clang/hvm.c +++ b/clang/hvm.c @@ -383,7 +383,8 @@ static int PARSE_FORK_SIDE = -1; // -1 = off, 0 = left branch (DP0), 1 = #include "prim/fn/uid.c" #include "prim/fn/process/_.c" #include "prim/fn/stream/_.c" -#include "prim/fn/https/_.c" +#include "prim/fn/http/_.c" +#include "prim/fn/tcp/_.c" #include "prim/fn/read_bytes.c" #include "prim/fn/write_bytes.c" #include "prim/fn/read_file.c" diff --git a/clang/prim/init.c b/clang/prim/init.c index 6417ef8a..7c6eafbe 100644 --- a/clang/prim/init.c +++ b/clang/prim/init.c @@ -8,7 +8,8 @@ fn void prim_init(void) { prim_process_init(); prim_stream_init(); prim_timer_init(); - prim_https_init(); + prim_http_init(); + prim_tcp_init(); prim_env_init(); prim_cwd_init(); prim_chdir_init(); diff --git a/docs/hvm/core.md b/docs/hvm/core.md index 4bd616d4..fa1dcc12 100644 --- a/docs/hvm/core.md +++ b/docs/hvm/core.md @@ -59,7 +59,15 @@ Oper ::= "+" | "-" | "*" | "/" | "%" | "&&" | "||" `#Pend`, and `#Rdy` under `#OK{...}`, or `#ERR{String}`; stream primitives (`%stream_stdin_open`, `%stream_file_open`, `%stream_poll`, `%stream_wait`, `%stream_close`) use `#Strm`, `#Pend`, `#Rdy`, `#Byt`, and `#Eof` under - `#OK{...}`, or `#ERR{String}` (`%stream_close` returns `#OK{#Nil}`); https - primitives (`%https_get`, `%https_poll`, `%https_wait`, `%https_cancel`) use - `#Http`, `#Pend`, and `#Rdy` under `#OK{...}`, with outcomes `#Resp{status,#Nil,body}`, - `#Fail{code,msg}`, or `#Canceled`, or return `#ERR{String}`. + `#OK{...}`, or `#ERR{String}` (`%stream_close` returns `#OK{#Nil}`); http + primitives (`%http_request`, `%http_poll`, `%http_wait`, `%http_cancel`) use + `#Http`, `#Pend`, and `#Rdy` under `#OK{...}`, where `%http_request` expects + `#Req{method,url,headers,body,opts}` and outcomes are + `#Resp{status,headers,body}`, `#Fail{reason,msg}`, or `#Canceled` + (all under `#OK{...}`), or `#ERR{String}`; tcp primitives (`%tcp_connect`, + `%tcp_connect_poll`, `%tcp_connect_wait`, `%tcp_recv_poll`, `%tcp_recv_wait`, + `%tcp_send_poll`, `%tcp_send_wait`, `%tcp_close`) use `#Tcp`, `#Pend`, and + `#Rdy` under `#OK{...}`; `%tcp_connect` expects + `#TcpReq{host,port,#TcpOpts{connect_timeout_ms,read_timeout_ms,write_timeout_ms,nodelay,keepalive}}` + and outcomes are `#Conn`, `#Recv`, `#Sent`, `#Eof`, `#Closed`, or + `#Fail{reason,msg}` with reason in `#Timeout|#Dns|#Refused|#Unreachable|#Reset|#BrokenPipe|#Protocol|#NotConnected|#Sys{errno}`. diff --git a/docs/hvm/syntax.md b/docs/hvm/syntax.md index 8e7876f9..1fb9103b 100644 --- a/docs/hvm/syntax.md +++ b/docs/hvm/syntax.md @@ -243,10 +243,29 @@ can be written as `_ : d` or as a bare `d`. - `%timer_start(ms)` returns `#OK{#Time{id,seq}}` or `#ERR{String}`. - `%timer_poll(time)` returns `#OK{#Pend{time2}|#Rdy{time2}}` or `#ERR{String}`. - `%timer_wait(time)` returns `#OK{#Rdy{time2}}` or `#ERR{String}`. -- `%https_get(url)` returns `#OK{#Http{id,seq}}` or `#ERR{String}`. -- `%https_poll(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,#Nil,body}|#Fail{code,msg}|#Canceled}}` or `#ERR{String}`. -- `%https_wait(http)` returns `#OK{#Rdy{http2,#Resp{status,#Nil,body}|#Fail{code,msg}|#Canceled}}` or `#ERR{String}`. -- `%https_cancel(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,#Nil,body}|#Fail{code,msg}|#Canceled}}` or `#ERR{String}`. +- `%http_request(req)` returns `#OK{#Http{id,seq}}` or `#ERR{String}`. +- `req` must be `#Req{method,url,headers,body,opts}`: + - `method`: `#Get|#Post|#Put|#Patch|#Delete|#Head|#Options` + - `headers`: `List<#Hdr{name,value}>` + - `body`: `#NoBody|#BodyText{String}|#BodyBytes{List<#Byt{n}>}` + - `opts`: `#Opts{timeout_ms,connect_timeout_ms,follow_redirects,max_redirects,verify_tls,max_body_bytes}` +- `%http_poll(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,headers,body}|#Fail{reason,msg}|#Canceled}}` or `#ERR{String}`. +- `%http_wait(http)` returns `#OK{#Rdy{http2,#Resp{status,headers,body}|#Fail{reason,msg}|#Canceled}}` or `#ERR{String}`. +- `%http_cancel(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,headers,body}|#Fail{reason,msg}|#Canceled}}` or `#ERR{String}`. +- `%tcp_connect(req)` returns `#OK{#Tcp{id,seq}}` or `#ERR{String}`. +- `req` must be `#TcpReq{host,port,opts}`: + - `host`: `String` + - `port`: `NUM` in `[1,65535]` + - `opts`: `#TcpOpts{connect_timeout_ms,read_timeout_ms,write_timeout_ms,nodelay,keepalive}` +- `%tcp_connect_poll(tcp)` returns `#OK{#Pend{tcp2}|#Rdy{tcp2,#Conn{}|#Fail{reason,msg}}}` or `#ERR{String}`. +- `%tcp_connect_wait(tcp)` returns `#OK{#Rdy{tcp2,#Conn{}|#Fail{reason,msg}}}` or `#ERR{String}`. +- `%tcp_recv_poll(tcp,max_bytes)` returns `#OK{#Pend{tcp2}|#Rdy{tcp2,#Recv{bytes}|#Eof{}|#Fail{reason,msg}}}` or `#ERR{String}`. +- `%tcp_recv_wait(tcp,max_bytes)` returns `#OK{#Rdy{tcp2,#Recv{bytes}|#Eof{}|#Fail{reason,msg}}}` or `#ERR{String}`. +- `%tcp_send_poll(tcp,bytes)` returns `#OK{#Pend{tcp2}|#Rdy{tcp2,#Sent{n}|#Fail{reason,msg}}}` or `#ERR{String}`. +- `%tcp_send_wait(tcp,bytes)` returns `#OK{#Rdy{tcp2,#Sent{n}|#Fail{reason,msg}}}` or `#ERR{String}`. +- `%tcp_close(tcp)` returns `#OK{#Rdy{tcp2,#Closed{}|#Fail{reason,msg}}}` or `#ERR{String}`. +- TCP fail reasons are `#Timeout`, `#Dns`, `#Refused`, `#Unreachable`, + `#Reset`, `#BrokenPipe`, `#Protocol`, `#NotConnected`, or `#Sys{errno}`. ## Priority wrapper and wildcard diff --git a/test/prim_http_cancel_bad_handle.hvm4 b/test/prim_http_cancel_bad_handle.hvm4 new file mode 100644 index 00000000..4512d114 --- /dev/null +++ b/test/prim_http_cancel_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %http_cancel(#Http{0,0}) +//EXPECT_CONTAINS:ERROR(http_cancel): E2 diff --git a/test/prim_http_poll_bad_handle.hvm4 b/test/prim_http_poll_bad_handle.hvm4 new file mode 100644 index 00000000..7707552a --- /dev/null +++ b/test/prim_http_poll_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %http_poll(#Http{0,0}) +//EXPECT_CONTAINS:ERROR(http_poll): E2 diff --git a/test/prim_http_request_bad_arg.hvm4 b/test/prim_http_request_bad_arg.hvm4 new file mode 100644 index 00000000..ecaa0e9a --- /dev/null +++ b/test/prim_http_request_bad_arg.hvm4 @@ -0,0 +1,2 @@ +@main = %http_request(0) +//EXPECT_CONTAINS:ERROR(http_request): E1 diff --git a/test/prim_http_wait_era.hvm4 b/test/prim_http_wait_era.hvm4 new file mode 100644 index 00000000..5dfba11e --- /dev/null +++ b/test/prim_http_wait_era.hvm4 @@ -0,0 +1,2 @@ +@main = %http_wait(&{}) +//!&{} diff --git a/test/prim_https_cancel_bad_handle.hvm4 b/test/prim_https_cancel_bad_handle.hvm4 deleted file mode 100644 index 0f59854c..00000000 --- a/test/prim_https_cancel_bad_handle.hvm4 +++ /dev/null @@ -1,2 +0,0 @@ -@main = %https_cancel(#Http{0,0}) -//EXPECT_CONTAINS:ERROR(https_cancel): E2 diff --git a/test/prim_https_get_bad_arg.hvm4 b/test/prim_https_get_bad_arg.hvm4 deleted file mode 100644 index 76b78149..00000000 --- a/test/prim_https_get_bad_arg.hvm4 +++ /dev/null @@ -1,2 +0,0 @@ -@main = %https_get(0) -//EXPECT_CONTAINS:ERROR(https_get): invalid `url` diff --git a/test/prim_https_poll_bad_handle.hvm4 b/test/prim_https_poll_bad_handle.hvm4 deleted file mode 100644 index af6ca2ec..00000000 --- a/test/prim_https_poll_bad_handle.hvm4 +++ /dev/null @@ -1,2 +0,0 @@ -@main = %https_poll(#Http{0,0}) -//EXPECT_CONTAINS:ERROR(https_poll): E2 diff --git a/test/prim_https_wait_era.hvm4 b/test/prim_https_wait_era.hvm4 deleted file mode 100644 index 5ac6a314..00000000 --- a/test/prim_https_wait_era.hvm4 +++ /dev/null @@ -1,2 +0,0 @@ -@main = %https_wait(&{}) -//!&{} diff --git a/test/prim_tcp_close_bad_handle.hvm4 b/test/prim_tcp_close_bad_handle.hvm4 new file mode 100644 index 00000000..a730e10f --- /dev/null +++ b/test/prim_tcp_close_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_close(#Tcp{0,0}) +//EXPECT_CONTAINS:ERROR(tcp_close): E2 diff --git a/test/prim_tcp_close_era.hvm4 b/test/prim_tcp_close_era.hvm4 new file mode 100644 index 00000000..f3a07d6d --- /dev/null +++ b/test/prim_tcp_close_era.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_close(&{}) +//!&{} diff --git a/test/prim_tcp_connect_bad_arg.hvm4 b/test/prim_tcp_connect_bad_arg.hvm4 new file mode 100644 index 00000000..aec2a2bd --- /dev/null +++ b/test/prim_tcp_connect_bad_arg.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_connect(0) +//EXPECT_CONTAINS:ERROR(tcp_connect): E1 diff --git a/test/prim_tcp_connect_poll_bad_handle.hvm4 b/test/prim_tcp_connect_poll_bad_handle.hvm4 new file mode 100644 index 00000000..de541a46 --- /dev/null +++ b/test/prim_tcp_connect_poll_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_connect_poll(#Tcp{0,0}) +//EXPECT_CONTAINS:ERROR(tcp_connect_poll): E2 diff --git a/test/prim_tcp_connect_wait_era.hvm4 b/test/prim_tcp_connect_wait_era.hvm4 new file mode 100644 index 00000000..c829e664 --- /dev/null +++ b/test/prim_tcp_connect_wait_era.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_connect_wait(&{}) +//!&{} diff --git a/test/prim_tcp_recv_poll_bad_handle.hvm4 b/test/prim_tcp_recv_poll_bad_handle.hvm4 new file mode 100644 index 00000000..39cc3e27 --- /dev/null +++ b/test/prim_tcp_recv_poll_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_recv_poll(#Tcp{0,0}, 16) +//EXPECT_CONTAINS:ERROR(tcp_recv_poll): E2 diff --git a/test/prim_tcp_recv_wait_era_arg.hvm4 b/test/prim_tcp_recv_wait_era_arg.hvm4 new file mode 100644 index 00000000..271340b6 --- /dev/null +++ b/test/prim_tcp_recv_wait_era_arg.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_recv_wait(#Tcp{0,0}, &{}) +//!&{} diff --git a/test/prim_tcp_send_poll_bad_handle.hvm4 b/test/prim_tcp_send_poll_bad_handle.hvm4 new file mode 100644 index 00000000..b4718f7e --- /dev/null +++ b/test/prim_tcp_send_poll_bad_handle.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_send_poll(#Tcp{0,0}, []) +//EXPECT_CONTAINS:ERROR(tcp_send_poll): E2 diff --git a/test/prim_tcp_send_wait_era_arg.hvm4 b/test/prim_tcp_send_wait_era_arg.hvm4 new file mode 100644 index 00000000..019ca5b7 --- /dev/null +++ b/test/prim_tcp_send_wait_era_arg.hvm4 @@ -0,0 +1,2 @@ +@main = %tcp_send_wait(#Tcp{0,0}, &{}) +//!&{} From 64b675e32061336426b3c00cf05010c5d89f3a81 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Wed, 11 Feb 2026 17:38:36 +0400 Subject: [PATCH 26/35] prim tests --- test.hvm4 | 31 +++++++++++++++++++ test/prim_argv_with_args.hvm4 | 3 ++ test/prim_chdir_dot_ok.hvm4 | 10 ++++++ test/prim_chdir_invalid_shape_err.hvm4 | 10 ++++++ test/prim_chdir_missing_err.hvm4 | 10 ++++++ test/prim_chdir_path_inner_mix.hvm4 | 3 ++ test/prim_chdir_path_mix_inc_sup_era.hvm4 | 3 ++ test/prim_cwd_after_chdir_tmp.hvm4 | 10 ++++++ test/prim_env_bad_shape_err.hvm4 | 10 ++++++ test/prim_env_invalid_utf32_err.hvm4 | 10 ++++++ test/prim_env_missing_var_err.hvm4 | 10 ++++++ test/prim_env_name_mix_inc_sup_era.hvm4 | 10 ++++++ test/prim_env_path_ok.hvm4 | 10 ++++++ ...prim_panic_aborts_before_continuation.hvm4 | 3 ++ ...im_panic_message_inner_mix_inc_aborts.hvm4 | 3 ++ test/prim_rand_non_negative.hvm4 | 2 ++ test/prim_read_bytes_missing.hvm4 | 11 +++++++ test/prim_read_bytes_path_inner_mix.hvm4 | 13 ++++++++ .../prim_read_bytes_path_mix_inc_sup_era.hvm4 | 12 +++++++ test/prim_read_file_invalid_utf8.hvm4 | 19 ++++++++++++ test/prim_read_file_missing.hvm4 | 11 +++++++ test/prim_read_file_path_inner_mix.hvm4 | 12 +++++++ test/prim_read_file_path_mix_inc_sup_era.hvm4 | 11 +++++++ test/prim_uid_distinct.hvm4 | 2 ++ test/prim_uid_prefix.hvm4 | 2 ++ test/prim_uuid_prefix.hvm4 | 2 ++ test/prim_write_bytes_data_inner_mix.hvm4 | 5 +++ ...prim_write_bytes_data_mix_inc_sup_era.hvm4 | 5 +++ test/prim_write_bytes_invalid_byte.hvm4 | 12 +++++++ test/prim_write_bytes_invalid_data_shape.hvm4 | 11 +++++++ test/prim_write_bytes_read_bytes_binary.hvm4 | 12 +++++++ test/prim_write_file_data_inner_mix.hvm4 | 5 +++ .../prim_write_file_data_mix_inc_sup_era.hvm4 | 4 +++ test/prim_write_file_invalid_data_shape.hvm4 | 11 +++++++ test/prim_write_file_invalid_path_shape.hvm4 | 11 +++++++ test/prim_write_file_invalid_utf32.hvm4 | 12 +++++++ .../prim_write_file_path_mix_inc_sup_era.hvm4 | 4 +++ test/prim_write_file_read_bytes_ascii.hvm4 | 12 +++++++ test/prim_write_file_read_file_empty.hvm4 | 12 +++++++ test/prim_write_file_read_file_roundtrip.hvm4 | 12 +++++++ 40 files changed, 361 insertions(+) create mode 100644 test.hvm4 create mode 100644 test/prim_argv_with_args.hvm4 create mode 100644 test/prim_chdir_dot_ok.hvm4 create mode 100644 test/prim_chdir_invalid_shape_err.hvm4 create mode 100644 test/prim_chdir_missing_err.hvm4 create mode 100644 test/prim_chdir_path_inner_mix.hvm4 create mode 100644 test/prim_chdir_path_mix_inc_sup_era.hvm4 create mode 100644 test/prim_cwd_after_chdir_tmp.hvm4 create mode 100644 test/prim_env_bad_shape_err.hvm4 create mode 100644 test/prim_env_invalid_utf32_err.hvm4 create mode 100644 test/prim_env_missing_var_err.hvm4 create mode 100644 test/prim_env_name_mix_inc_sup_era.hvm4 create mode 100644 test/prim_env_path_ok.hvm4 create mode 100644 test/prim_panic_aborts_before_continuation.hvm4 create mode 100644 test/prim_panic_message_inner_mix_inc_aborts.hvm4 create mode 100644 test/prim_rand_non_negative.hvm4 create mode 100644 test/prim_read_bytes_missing.hvm4 create mode 100644 test/prim_read_bytes_path_inner_mix.hvm4 create mode 100644 test/prim_read_bytes_path_mix_inc_sup_era.hvm4 create mode 100644 test/prim_read_file_invalid_utf8.hvm4 create mode 100644 test/prim_read_file_missing.hvm4 create mode 100644 test/prim_read_file_path_inner_mix.hvm4 create mode 100644 test/prim_read_file_path_mix_inc_sup_era.hvm4 create mode 100644 test/prim_uid_distinct.hvm4 create mode 100644 test/prim_uid_prefix.hvm4 create mode 100644 test/prim_uuid_prefix.hvm4 create mode 100644 test/prim_write_bytes_data_inner_mix.hvm4 create mode 100644 test/prim_write_bytes_data_mix_inc_sup_era.hvm4 create mode 100644 test/prim_write_bytes_invalid_byte.hvm4 create mode 100644 test/prim_write_bytes_invalid_data_shape.hvm4 create mode 100644 test/prim_write_bytes_read_bytes_binary.hvm4 create mode 100644 test/prim_write_file_data_inner_mix.hvm4 create mode 100644 test/prim_write_file_data_mix_inc_sup_era.hvm4 create mode 100644 test/prim_write_file_invalid_data_shape.hvm4 create mode 100644 test/prim_write_file_invalid_path_shape.hvm4 create mode 100644 test/prim_write_file_invalid_utf32.hvm4 create mode 100644 test/prim_write_file_path_mix_inc_sup_era.hvm4 create mode 100644 test/prim_write_file_read_bytes_ascii.hvm4 create mode 100644 test/prim_write_file_read_file_empty.hvm4 create mode 100644 test/prim_write_file_read_file_roundtrip.hvm4 diff --git a/test.hvm4 b/test.hvm4 new file mode 100644 index 00000000..d8f74ba8 --- /dev/null +++ b/test.hvm4 @@ -0,0 +1,31 @@ +//@test_panic = #Pair{%panic((λx.x<>"A")('∀')), 33} +//@test_concat = %concat((λx.x<>[])([1,2]), [3]) +// +//@main = @test_panic +//@main = @test_concat +// +////@main = %concat([1,2],[3]) +////@main = %log(&L{1,2}) +// +// +@trace = λa.λb. !!v = %log(a); b +@main = @trace("works", 90) + + + + + + + + + + + + + + + + + + + diff --git a/test/prim_argv_with_args.hvm4 b/test/prim_argv_with_args.hvm4 new file mode 100644 index 00000000..506aa453 --- /dev/null +++ b/test/prim_argv_with_args.hvm4 @@ -0,0 +1,3 @@ +@main = %argv(0) +//FLAGS: -- alpha beta +//!["alpha","beta"] diff --git a/test/prim_chdir_dot_ok.hvm4 b/test/prim_chdir_dot_ok.hvm4 new file mode 100644 index 00000000..7bcc03d4 --- /dev/null +++ b/test/prim_chdir_dot_ok.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_chdir_dot_ok +@main = @tag(%chdir(".")) +//!"OK" diff --git a/test/prim_chdir_invalid_shape_err.hvm4 b/test/prim_chdir_invalid_shape_err.hvm4 new file mode 100644 index 00000000..6cc3a82f --- /dev/null +++ b/test/prim_chdir_invalid_shape_err.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_chdir_invalid_shape_err +@main = @tag(%chdir(1)) +//!"ERR" diff --git a/test/prim_chdir_missing_err.hvm4 b/test/prim_chdir_missing_err.hvm4 new file mode 100644 index 00000000..dae112ee --- /dev/null +++ b/test/prim_chdir_missing_err.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_chdir_missing_err +@main = @tag(%chdir("/tmp/hvm4_missing_chdir_001")) +//!"ERR" diff --git a/test/prim_chdir_path_inner_mix.hvm4 b/test/prim_chdir_path_inner_mix.hvm4 new file mode 100644 index 00000000..6f1be192 --- /dev/null +++ b/test/prim_chdir_path_inner_mix.hvm4 @@ -0,0 +1,3 @@ +// prim_chdir_path_inner_mix +@main = %chdir('/'<>&L{&{},↑"tmp"}) +//!&L{&{},↑#OK{[]}} diff --git a/test/prim_chdir_path_mix_inc_sup_era.hvm4 b/test/prim_chdir_path_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..8ccbd44e --- /dev/null +++ b/test/prim_chdir_path_mix_inc_sup_era.hvm4 @@ -0,0 +1,3 @@ +// prim_chdir_path_mix_inc_sup_era +@main = %chdir(↑&L{&{}, "."}) +//!↑&L{&{},#OK{[]}} diff --git a/test/prim_cwd_after_chdir_tmp.hvm4 b/test/prim_cwd_after_chdir_tmp.hvm4 new file mode 100644 index 00000000..33c79010 --- /dev/null +++ b/test/prim_cwd_after_chdir_tmp.hvm4 @@ -0,0 +1,10 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_cwd_after_chdir_tmp +@main = @bind(%chdir("/tmp"), λx.%cwd(0)) +//!#OK{"/tmp"} diff --git a/test/prim_env_bad_shape_err.hvm4 b/test/prim_env_bad_shape_err.hvm4 new file mode 100644 index 00000000..0f808f53 --- /dev/null +++ b/test/prim_env_bad_shape_err.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_env_bad_shape_err +@main = @tag(%env(1)) +//!"ERR" diff --git a/test/prim_env_invalid_utf32_err.hvm4 b/test/prim_env_invalid_utf32_err.hvm4 new file mode 100644 index 00000000..a0c4f255 --- /dev/null +++ b/test/prim_env_invalid_utf32_err.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_env_invalid_utf32_err +@main = @tag(%env(#CON{#CHR{55296}, #NIL})) +//!"ERR" diff --git a/test/prim_env_missing_var_err.hvm4 b/test/prim_env_missing_var_err.hvm4 new file mode 100644 index 00000000..0380a7ef --- /dev/null +++ b/test/prim_env_missing_var_err.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_env_missing_var_err +@main = @tag(%env("__HVM4_SHOULD_NOT_EXIST__")) +//!"ERR" diff --git a/test/prim_env_name_mix_inc_sup_era.hvm4 b/test/prim_env_name_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..49e8d371 --- /dev/null +++ b/test/prim_env_name_mix_inc_sup_era.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_env_name_mix_inc_sup_era +@main = @tag(%env(↑&L{&{}, "PATH"})) +//!↑&L{&{},"OK"} diff --git a/test/prim_env_path_ok.hvm4 b/test/prim_env_path_ok.hvm4 new file mode 100644 index 00000000..450eed25 --- /dev/null +++ b/test/prim_env_path_ok.hvm4 @@ -0,0 +1,10 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_env_path_ok +@main = @tag(%env("PATH")) +//!"OK" diff --git a/test/prim_panic_aborts_before_continuation.hvm4 b/test/prim_panic_aborts_before_continuation.hvm4 new file mode 100644 index 00000000..8817ed0b --- /dev/null +++ b/test/prim_panic_aborts_before_continuation.hvm4 @@ -0,0 +1,3 @@ +// prim_panic_aborts_before_continuation +@main = !!x = %panic("panic_001_basic"); "panic_should_not_print" +//panic_001_basic diff --git a/test/prim_panic_message_inner_mix_inc_aborts.hvm4 b/test/prim_panic_message_inner_mix_inc_aborts.hvm4 new file mode 100644 index 00000000..c184c367 --- /dev/null +++ b/test/prim_panic_message_inner_mix_inc_aborts.hvm4 @@ -0,0 +1,3 @@ +// prim_panic_message_inner_mix_inc_aborts +@main = %panic('p'<>↑"anic_inc") +//panic_inc diff --git a/test/prim_rand_non_negative.hvm4 b/test/prim_rand_non_negative.hvm4 new file mode 100644 index 00000000..68827ecc --- /dev/null +++ b/test/prim_rand_non_negative.hvm4 @@ -0,0 +1,2 @@ +@main = (%rand(0) >= 0) +//1 diff --git a/test/prim_read_bytes_missing.hvm4 b/test/prim_read_bytes_missing.hvm4 new file mode 100644 index 00000000..111b3873 --- /dev/null +++ b/test/prim_read_bytes_missing.hvm4 @@ -0,0 +1,11 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_read_bytes_missing +@path_007 = "/tmp/hvm4_io_missing_007.bin" +@main = @tag(%read_bytes(@path_007)) +//!"ERR" diff --git a/test/prim_read_bytes_path_inner_mix.hvm4 b/test/prim_read_bytes_path_inner_mix.hvm4 new file mode 100644 index 00000000..a07fac0b --- /dev/null +++ b/test/prim_read_bytes_path_inner_mix.hvm4 @@ -0,0 +1,13 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_read_bytes_path_inner_mix +@path_020 = "/tmp/hvm4_io_020.bin" +@bytes_020 = #CON{#BYT{9}, #NIL} +@path_inner_020 = '/'<>&L{&{},↑"tmp/hvm4_io_020.bin"} +@main = @bind(%write_bytes(@path_020, @bytes_020), λx.%read_bytes(@path_inner_020)) +//!&L{&{},↑#OK{[#BYT{9}]}} diff --git a/test/prim_read_bytes_path_mix_inc_sup_era.hvm4 b/test/prim_read_bytes_path_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..f6f74c73 --- /dev/null +++ b/test/prim_read_bytes_path_mix_inc_sup_era.hvm4 @@ -0,0 +1,12 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_read_bytes_path_mix_inc_sup_era +@path_014 = "/tmp/hvm4_io_014.bin" +@bytes_014 = #CON{#BYT{7}, #NIL} +@main = @bind(%write_bytes(@path_014, @bytes_014), λx.%read_bytes(↑&L{@path_014, &{}})) +//!↑&L{#OK{[#BYT{7}]},&{}} diff --git a/test/prim_read_file_invalid_utf8.hvm4 b/test/prim_read_file_invalid_utf8.hvm4 new file mode 100644 index 00000000..6186269f --- /dev/null +++ b/test/prim_read_file_invalid_utf8.hvm4 @@ -0,0 +1,19 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_read_file_invalid_utf8 +@path_005 = "/tmp/hvm4_io_005.bin" +@bytes_005 = #CON{#BYT{195}, #NIL} +@main = @bind(%write_bytes(@path_005, @bytes_005), λx.@tag(%read_file(@path_005))) +//!"ERR" diff --git a/test/prim_read_file_missing.hvm4 b/test/prim_read_file_missing.hvm4 new file mode 100644 index 00000000..64ad8287 --- /dev/null +++ b/test/prim_read_file_missing.hvm4 @@ -0,0 +1,11 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_read_file_missing +@path_006 = "/tmp/hvm4_io_missing_006.txt" +@main = @tag(%read_file(@path_006)) +//!"ERR" diff --git a/test/prim_read_file_path_inner_mix.hvm4 b/test/prim_read_file_path_inner_mix.hvm4 new file mode 100644 index 00000000..69fa8b87 --- /dev/null +++ b/test/prim_read_file_path_inner_mix.hvm4 @@ -0,0 +1,12 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_read_file_path_inner_mix +@path_018 = "/tmp/hvm4_io_018.txt" +@path_inner_018 = '/'<>&L{&{},↑"tmp/hvm4_io_018.txt"} +@main = @bind(%write_file(@path_018, "inner-path"), λx.%read_file(@path_inner_018)) +//!&L{&{},↑#OK{"inner-path"}} diff --git a/test/prim_read_file_path_mix_inc_sup_era.hvm4 b/test/prim_read_file_path_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..df9508da --- /dev/null +++ b/test/prim_read_file_path_mix_inc_sup_era.hvm4 @@ -0,0 +1,11 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_read_file_path_mix_inc_sup_era +@path_013 = "/tmp/hvm4_io_013.txt" +@main = @bind(%write_file(@path_013, "mix-rf"), λx.%read_file(↑&L{&{},@path_013})) +//!↑&L{&{},#OK{"mix-rf"}} diff --git a/test/prim_uid_distinct.hvm4 b/test/prim_uid_distinct.hvm4 new file mode 100644 index 00000000..d864e259 --- /dev/null +++ b/test/prim_uid_distinct.hvm4 @@ -0,0 +1,2 @@ +@main = (%uid(0) === %uid(0)) +//0 diff --git a/test/prim_uid_prefix.hvm4 b/test/prim_uid_prefix.hvm4 new file mode 100644 index 00000000..170def4d --- /dev/null +++ b/test/prim_uid_prefix.hvm4 @@ -0,0 +1,2 @@ +@main = %uid(0) +//EXPECT_PREFIX:"uid- diff --git a/test/prim_uuid_prefix.hvm4 b/test/prim_uuid_prefix.hvm4 new file mode 100644 index 00000000..a7f17d2e --- /dev/null +++ b/test/prim_uuid_prefix.hvm4 @@ -0,0 +1,2 @@ +@main = %uuid(0) +//EXPECT_PREFIX:#OK{" diff --git a/test/prim_write_bytes_data_inner_mix.hvm4 b/test/prim_write_bytes_data_inner_mix.hvm4 new file mode 100644 index 00000000..4555bfc7 --- /dev/null +++ b/test/prim_write_bytes_data_inner_mix.hvm4 @@ -0,0 +1,5 @@ +// prim_write_bytes_data_inner_mix +@path_021 = "/tmp/hvm4_io_021.bin" +@bytes_021 = #CON{#BYT{65}, #CON{&L{&{},↑#BYT{66}}, #NIL}} +@main = %write_bytes(@path_021, @bytes_021) +//!&L{&{},↑#OK{[]}} diff --git a/test/prim_write_bytes_data_mix_inc_sup_era.hvm4 b/test/prim_write_bytes_data_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..ad01ca46 --- /dev/null +++ b/test/prim_write_bytes_data_mix_inc_sup_era.hvm4 @@ -0,0 +1,5 @@ +// prim_write_bytes_data_mix_inc_sup_era +@path_017 = "/tmp/hvm4_io_017.bin" +@bytes_017 = #CON{#BYT{33}, #NIL} +@main = %write_bytes(@path_017, &L{↑@bytes_017, &{}}) +//!&L{↑#OK{[]},&{}} diff --git a/test/prim_write_bytes_invalid_byte.hvm4 b/test/prim_write_bytes_invalid_byte.hvm4 new file mode 100644 index 00000000..987a90cf --- /dev/null +++ b/test/prim_write_bytes_invalid_byte.hvm4 @@ -0,0 +1,12 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_write_bytes_invalid_byte +@path_011 = "/tmp/hvm4_io_011.bin" +@bytes_011 = #CON{#BYT{300}, #NIL} +@main = @tag(%write_bytes(@path_011, @bytes_011)) +//!"ERR" diff --git a/test/prim_write_bytes_invalid_data_shape.hvm4 b/test/prim_write_bytes_invalid_data_shape.hvm4 new file mode 100644 index 00000000..e785ce68 --- /dev/null +++ b/test/prim_write_bytes_invalid_data_shape.hvm4 @@ -0,0 +1,11 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_write_bytes_invalid_data_shape +@path_010 = "/tmp/hvm4_io_010.bin" +@main = @tag(%write_bytes(@path_010, 1)) +//!"ERR" diff --git a/test/prim_write_bytes_read_bytes_binary.hvm4 b/test/prim_write_bytes_read_bytes_binary.hvm4 new file mode 100644 index 00000000..9c24e61f --- /dev/null +++ b/test/prim_write_bytes_read_bytes_binary.hvm4 @@ -0,0 +1,12 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_write_read_bytes_binary +@path_004 = "/tmp/hvm4_io_004.bin" +@bytes_004 = #CON{#BYT{0}, #CON{#BYT{1}, #CON{#BYT{2}, #CON{#BYT{255}, #NIL}}}} +@main = @bind(%write_bytes(@path_004, @bytes_004), λx.%read_bytes(@path_004)) +//!#OK{[#BYT{0},#BYT{1},#BYT{2},#BYT{255}]} diff --git a/test/prim_write_file_data_inner_mix.hvm4 b/test/prim_write_file_data_inner_mix.hvm4 new file mode 100644 index 00000000..154aa81f --- /dev/null +++ b/test/prim_write_file_data_inner_mix.hvm4 @@ -0,0 +1,5 @@ +// prim_write_file_data_inner_mix +@path_019 = "/tmp/hvm4_io_019.txt" +@text_019 = 'a'<>&L{&{},↑'b'}<>'c'<>[] +@main = %write_file(@path_019, @text_019) +//!&L{&{},↑#OK{[]}} diff --git a/test/prim_write_file_data_mix_inc_sup_era.hvm4 b/test/prim_write_file_data_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..35722697 --- /dev/null +++ b/test/prim_write_file_data_mix_inc_sup_era.hvm4 @@ -0,0 +1,4 @@ +// prim_write_file_data_mix_inc_sup_era +@path_016 = "/tmp/hvm4_io_016.txt" +@main = %write_file(@path_016, &L{↑"mix-data", &{}}) +//!&L{↑#OK{[]},&{}} diff --git a/test/prim_write_file_invalid_data_shape.hvm4 b/test/prim_write_file_invalid_data_shape.hvm4 new file mode 100644 index 00000000..9b573cf3 --- /dev/null +++ b/test/prim_write_file_invalid_data_shape.hvm4 @@ -0,0 +1,11 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_write_file_invalid_data_shape +@path_009 = "/tmp/hvm4_io_009.txt" +@main = @tag(%write_file(@path_009, 1)) +//!"ERR" diff --git a/test/prim_write_file_invalid_path_shape.hvm4 b/test/prim_write_file_invalid_path_shape.hvm4 new file mode 100644 index 00000000..9faec298 --- /dev/null +++ b/test/prim_write_file_invalid_path_shape.hvm4 @@ -0,0 +1,11 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_write_file_invalid_path_shape +@text_008 = "x" +@main = @tag(%write_file(1, @text_008)) +//!"ERR" diff --git a/test/prim_write_file_invalid_utf32.hvm4 b/test/prim_write_file_invalid_utf32.hvm4 new file mode 100644 index 00000000..82029ab5 --- /dev/null +++ b/test/prim_write_file_invalid_utf32.hvm4 @@ -0,0 +1,12 @@ +@tag = λr. + λ{ + #OK: λx. "OK" + #ERR: λe. "ERR" + &{} + }(r) + +// prim_write_file_invalid_utf32 +@path_012 = "/tmp/hvm4_io_012.txt" +@text_012 = #CON{#CHR{55296}, #NIL} +@main = @tag(%write_file(@path_012, @text_012)) +//!"ERR" diff --git a/test/prim_write_file_path_mix_inc_sup_era.hvm4 b/test/prim_write_file_path_mix_inc_sup_era.hvm4 new file mode 100644 index 00000000..84b07aa9 --- /dev/null +++ b/test/prim_write_file_path_mix_inc_sup_era.hvm4 @@ -0,0 +1,4 @@ +// prim_write_file_path_mix_inc_sup_era +@path_015 = "/tmp/hvm4_io_015.txt" +@main = %write_file(&L{↑@path_015, &{}}, "mix-path") +//!&L{↑#OK{[]},&{}} diff --git a/test/prim_write_file_read_bytes_ascii.hvm4 b/test/prim_write_file_read_bytes_ascii.hvm4 new file mode 100644 index 00000000..d116ee96 --- /dev/null +++ b/test/prim_write_file_read_bytes_ascii.hvm4 @@ -0,0 +1,12 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_write_file_read_bytes_ascii +@path_003 = "/tmp/hvm4_io_003.txt" +@text_003 = "ABC" +@main = @bind(%write_file(@path_003, @text_003), λx.%read_bytes(@path_003)) +//!#OK{[#BYT{65},#BYT{66},#BYT{67}]} diff --git a/test/prim_write_file_read_file_empty.hvm4 b/test/prim_write_file_read_file_empty.hvm4 new file mode 100644 index 00000000..3bb2b749 --- /dev/null +++ b/test/prim_write_file_read_file_empty.hvm4 @@ -0,0 +1,12 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_write_read_file_empty +@path_002 = "/tmp/hvm4_io_002.txt" +@text_002 = "" +@main = @bind(%write_file(@path_002, @text_002), λx.%read_file(@path_002)) +//!#OK{[]} diff --git a/test/prim_write_file_read_file_roundtrip.hvm4 b/test/prim_write_file_read_file_roundtrip.hvm4 new file mode 100644 index 00000000..028acf81 --- /dev/null +++ b/test/prim_write_file_read_file_roundtrip.hvm4 @@ -0,0 +1,12 @@ +@bind = λr. λk. + λ{ + #OK: λx.k(x) + #ERR: λe.#ERR{e} + &{} + }(r) + +// prim_write_read_file_roundtrip +@path_001 = "/tmp/hvm4_io_001.txt" +@text_001 = "io_001_payload" +@main = @bind(%write_file(@path_001, @text_001), λx.%read_file(@path_001)) +//!#OK{"io_001_payload"} From 457d701f69b3957eeb9cbd02f6c2351cb7a18cbf Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Wed, 11 Feb 2026 11:20:31 -0300 Subject: [PATCH 27/35] fixes --- clang/prim/fn/http/_.c | 6 +++--- clang/prim/fn/stream/_.c | 4 +--- clang/prim/fn/stream/poll.c | 2 +- clang/prim/fn/stream/wait.c | 2 +- clang/prim/fn/tcp/_.c | 6 +++--- docs/hvm/core.md | 2 +- docs/hvm/syntax.md | 6 +++--- 7 files changed, 13 insertions(+), 15 deletions(-) diff --git a/clang/prim/fn/http/_.c b/clang/prim/fn/http/_.c index e1ac9b6c..29120b18 100644 --- a/clang/prim/fn/http/_.c +++ b/clang/prim/fn/http/_.c @@ -656,13 +656,13 @@ fn u8 http_parse_body_bytes_list(Term term, HttpReq *req, Term *err_out) { Term tail = heap_read(loc + 1); if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { - *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#Byt{n}>"); + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#BYT{n}>"); return 0; } Term num = wnf(heap_read(term_val(head))); if (term_tag(num) != NUM) { - *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected #Byt{NUM}"); + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected #BYT{NUM}"); return 0; } @@ -681,7 +681,7 @@ fn u8 http_parse_body_bytes_list(Term term, HttpReq *req, Term *err_out) { } if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { - *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#Byt{n}>"); + *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#BYT{n}>"); return 0; } diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c index c7d1cef2..69d7ca44 100644 --- a/clang/prim/fn/stream/_.c +++ b/clang/prim/fn/stream/_.c @@ -27,7 +27,6 @@ static pthread_mutex_t STREAM_LOCK = PTHREAD_MUTEX_INITIALIZER; static u32 STREAM_NAM_STRM = 0; static u32 STREAM_NAM_PEND = 0; static u32 STREAM_NAM_RDY = 0; -static u32 STREAM_NAM_BYT = 0; static u32 STREAM_NAM_EOF = 0; fn Term wnf(Term term); @@ -53,7 +52,7 @@ fn Term stream_new_pend(u32 id, u32 seq) { fn Term stream_new_byt(u32 byt) { Term arg = term_new_num(byt); - return term_new_ctr(STREAM_NAM_BYT, 1, &arg); + return term_new_ctr(NAM_BYT, 1, &arg); } fn Term stream_new_eof(void) { @@ -225,7 +224,6 @@ fn void prim_stream_init(void) { STREAM_NAM_STRM = nick_from_str("Strm", 4); STREAM_NAM_PEND = nick_from_str("Pend", 4); STREAM_NAM_RDY = nick_from_str("Rdy", 3); - STREAM_NAM_BYT = nick_from_str("Byt", 3); STREAM_NAM_EOF = nick_from_str("Eof", 3); prim_stream_stdin_open_init(); diff --git a/clang/prim/fn/stream/poll.c b/clang/prim/fn/stream/poll.c index 9a86b60c..2126e195 100644 --- a/clang/prim/fn/stream/poll.c +++ b/clang/prim/fn/stream/poll.c @@ -55,7 +55,7 @@ fn Term stream_poll_go_strm(Term *args) { // %stream_poll_go_io(strm) // ------------------------ -// #OK{#Pend{#Strm{id,seq+1}}|#Rdy{#Strm{id,seq+1},#Byt{n}|#Eof}} | #ERR{String} +// #OK{#Pend{#Strm{id,seq+1}}|#Rdy{#Strm{id,seq+1},#BYT{n}|#Eof}} | #ERR{String} fn Term prim_fn_stream_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/stream/wait.c b/clang/prim/fn/stream/wait.c index 985a944d..1c62c009 100644 --- a/clang/prim/fn/stream/wait.c +++ b/clang/prim/fn/stream/wait.c @@ -55,7 +55,7 @@ fn Term stream_wait_go_strm(Term *args) { // %stream_wait_go_io(strm) // ------------------------ -// #OK{#Rdy{#Strm{id,seq+1},#Byt{n}|#Eof}} | #ERR{String} +// #OK{#Rdy{#Strm{id,seq+1},#BYT{n}|#Eof}} | #ERR{String} fn Term prim_fn_stream_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/_.c b/clang/prim/fn/tcp/_.c index dfd219cd..964cb1b3 100644 --- a/clang/prim/fn/tcp/_.c +++ b/clang/prim/fn/tcp/_.c @@ -542,14 +542,14 @@ fn u8 tcp_decode_bytes( if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { free(buf); - *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#Byt{n}>"); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#BYT{n}>"); return 0; } Term num = wnf(heap_read(term_val(head))); if (term_tag(num) != NUM) { free(buf); - *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected #Byt{NUM}"); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected #BYT{NUM}"); return 0; } @@ -595,7 +595,7 @@ fn u8 tcp_decode_bytes( if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { free(buf); - *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#Byt{n}>"); + *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#BYT{n}>"); return 0; } diff --git a/docs/hvm/core.md b/docs/hvm/core.md index fa1dcc12..cc99c311 100644 --- a/docs/hvm/core.md +++ b/docs/hvm/core.md @@ -58,7 +58,7 @@ Oper ::= "+" | "-" | "*" | "/" | "%" | "&&" | "||" timer primitives (`%timer_start`, `%timer_poll`, `%timer_wait`) use `#Time`, `#Pend`, and `#Rdy` under `#OK{...}`, or `#ERR{String}`; stream primitives (`%stream_stdin_open`, `%stream_file_open`, `%stream_poll`, `%stream_wait`, - `%stream_close`) use `#Strm`, `#Pend`, `#Rdy`, `#Byt`, and `#Eof` under + `%stream_close`) use `#Strm`, `#Pend`, `#Rdy`, `#BYT`, and `#Eof` under `#OK{...}`, or `#ERR{String}` (`%stream_close` returns `#OK{#Nil}`); http primitives (`%http_request`, `%http_poll`, `%http_wait`, `%http_cancel`) use `#Http`, `#Pend`, and `#Rdy` under `#OK{...}`, where `%http_request` expects diff --git a/docs/hvm/syntax.md b/docs/hvm/syntax.md index 1fb9103b..ced1b35c 100644 --- a/docs/hvm/syntax.md +++ b/docs/hvm/syntax.md @@ -237,8 +237,8 @@ can be written as `_ : d` or as a bare `d`. - `%process_kill(proc)` returns `#OK{#Pend{proc2}|#Rdy{...}}` or `#ERR{String}`. - `%stream_stdin_open(seed)` returns `#OK{#Strm{id,0}}` or `#ERR{String}`. - `%stream_file_open(path)` returns `#OK{#Strm{id,0}}` or `#ERR{String}`. -- `%stream_poll(strm)` returns `#OK{#Pend{strm2}|#Rdy{strm2,#Byt{n}|#Eof}}` or `#ERR{String}`. -- `%stream_wait(strm)` returns `#OK{#Rdy{strm2,#Byt{n}|#Eof}}` or `#ERR{String}`. +- `%stream_poll(strm)` returns `#OK{#Pend{strm2}|#Rdy{strm2,#BYT{n}|#Eof}}` or `#ERR{String}`. +- `%stream_wait(strm)` returns `#OK{#Rdy{strm2,#BYT{n}|#Eof}}` or `#ERR{String}`. - `%stream_close(strm)` returns `#OK{#Nil}` or `#ERR{String}`. - `%timer_start(ms)` returns `#OK{#Time{id,seq}}` or `#ERR{String}`. - `%timer_poll(time)` returns `#OK{#Pend{time2}|#Rdy{time2}}` or `#ERR{String}`. @@ -247,7 +247,7 @@ can be written as `_ : d` or as a bare `d`. - `req` must be `#Req{method,url,headers,body,opts}`: - `method`: `#Get|#Post|#Put|#Patch|#Delete|#Head|#Options` - `headers`: `List<#Hdr{name,value}>` - - `body`: `#NoBody|#BodyText{String}|#BodyBytes{List<#Byt{n}>}` + - `body`: `#NoBody|#BodyText{String}|#BodyBytes{List<#BYT{n}>}` - `opts`: `#Opts{timeout_ms,connect_timeout_ms,follow_redirects,max_redirects,verify_tls,max_body_bytes}` - `%http_poll(http)` returns `#OK{#Pend{http2}|#Rdy{http2,#Resp{status,headers,body}|#Fail{reason,msg}|#Canceled}}` or `#ERR{String}`. - `%http_wait(http)` returns `#OK{#Rdy{http2,#Resp{status,headers,body}|#Fail{reason,msg}|#Canceled}}` or `#ERR{String}`. From 03e04f07b8de825fd776c8625a0d55eb5163acae Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Wed, 11 Feb 2026 13:16:08 -0300 Subject: [PATCH 28/35] stdlib --- stdlib.hvm4 | 500 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 500 insertions(+) create mode 100644 stdlib.hvm4 diff --git a/stdlib.hvm4 b/stdlib.hvm4 new file mode 100644 index 00000000..35308d95 --- /dev/null +++ b/stdlib.hvm4 @@ -0,0 +1,500 @@ +// HVM4 stdlib helpers +// - Result combinators +// - Generic do-notation interpreter (flat steps) +// - Async wrappers (timer/process/stream/http/tcp) +// - File/system convenience wrappers + +// ----------------------------------------------------------------------------- +// Result Core +// ----------------------------------------------------------------------------- + +@pure = λx.#OK{x} +@ok = @pure + +@fail = λmsg.#ERR{msg} + +@bind = λr. λk. + λ{ + #OK: λx.k(x); + #ERR: λe.#ERR{e}; + &{} + }(r) + +@then = λr. λnext. + @bind(r, λu.next) + +@map = λr. λf. + @bind(r, λx.@pure(f(x))) + +@map_err = λr. λf. + λ{ + #OK: λx.#OK{x}; + #ERR: λe.#ERR{f(e)}; + &{} + }(r) + +@or_else = λr. λkerr. + λ{ + #OK: λx.#OK{x}; + #ERR: λe.kerr(e); + &{} + }(r) + +@log_ok = λmsg. + @pure(%log(msg)) + +@fst = λp. + λ{ + #Pack: λa. λb.a; + &{} + }(p) + +@snd = λp. + λ{ + #Pack: λa. λb.b; + &{} + }(p) + +@dup2 = λx. λk. + !d&D = x; + k(d₀, d₁) + +// ----------------------------------------------------------------------------- +// Do Notation Core +// ----------------------------------------------------------------------------- + +// @do(bind, pure, steps, cont) +// steps format: [wrap0, action0, wrap1, action1, ...] +// wrapN is an unscoped wrapper built with: ! f = λ x ; ... +@do = λ&bind. λ&pure. λsteps. λ&cont. + λ{ + []: pure(cont); + <>: λwrap. λtail. + λ{ + <>: λact. λrest. + bind(act, λv. + λ{ + #Pack: λrest2. λcont2. + @do(bind, pure, rest2, cont2); + &{} + }(wrap(#Pack{rest,cont})(v)) + ); + []: + #ERR{"do: malformed steps; expected [wrap,action,...]"} + }(tail) + }(steps) + +@do_ok = λsteps. λcont. + @do(@bind, @pure, steps, cont) + +// ----------------------------------------------------------------------------- +// Wait/Poll Normalization +// ----------------------------------------------------------------------------- + +// #OK{#Rdy{h}} | #ERR{...} +@wait1 = λr. + @bind(r, λrd. + λ{ + #Rdy: λh.@pure(h); + #Pend: λh.#ERR{"expected #Rdy; got #Pend"}; + &{} + }(rd) + ) + +// #OK{#Rdy{h,e}} | #ERR{...} +@wait2 = λr. + @bind(r, λrd. + λ{ + #Rdy: λh. λe.@pure(#Pack{h,e}); + #Pend: λh.#ERR{"expected #Rdy; got #Pend"}; + &{} + }(rd) + ) + +// passthrough normalizers for poll-style values +@poll1 = λr. + @bind(r, λx.@pure(x)) + +@poll2 = λr. + @bind(r, λx.@pure(x)) + +@await_poll1 = λ&poll. λh0. + ! f0 = λ st ; + @do_ok( + [ + f0, @poll1(poll(h0)) + ], + λ{ + #Pend: λh1.@await_poll1(poll, h1); + #Rdy: λh1.@pure(h1); + &{} + }(st) + ) + +@await_poll2 = λ&poll. λh0. + ! f0 = λ st ; + @do_ok( + [ + f0, @poll2(poll(h0)) + ], + λ{ + #Pend: λh1.@await_poll2(poll, h1); + #Rdy: λh1. λe1.@pure(#Pack{h1,e1}); + &{} + }(st) + ) + +// ----------------------------------------------------------------------------- +// Timer +// ----------------------------------------------------------------------------- + +@timer_start_ok = λms. + %timer_start(ms) + +@timer_poll_ok = λt. + %timer_poll(t) + +@timer_wait_ok = λt. + @wait1(%timer_wait(t)) + +@sleep_ms = λms. + ! f0 = λ t0 ; + ! f1 = λ t1 ; + @do_ok( + [ + f0, @timer_start_ok(ms), + f1, @timer_wait_ok(t0) + ], + [] + ) + +@sleep_s = λsec. + @sleep_ms(sec * 1000) + +// ----------------------------------------------------------------------------- +// Process +// ----------------------------------------------------------------------------- + +@process_spawn_ok = λcmd. + %process_spawn(cmd) + +@process_poll_ok = λproc. + %process_poll(proc) + +@process_wait_ok = λproc. + @wait2(%process_wait(proc)) + +@process_wait_evt = λproc. + ! f0 = λ w0 ; + @do_ok( + [ + f0, @process_wait_ok(proc) + ], + @snd(w0) + ) + +@process_kill_ok = λproc. + %process_kill(proc) + +@process_run = λcmd. + ! f0 = λ p0 ; + ! f1 = λ e1 ; + @do_ok( + [ + f0, @process_spawn_ok(cmd), + f1, @process_wait_evt(p0) + ], + e1 + ) + +// ----------------------------------------------------------------------------- +// Stream +// ----------------------------------------------------------------------------- + +@stream_stdin_open_ok = λseed. + %stream_stdin_open(seed) + +@stream_file_open_ok = λpath. + %stream_file_open(path) + +@stream_poll_ok = λstrm. + %stream_poll(strm) + +@stream_wait_ok = λstrm. + @wait2(%stream_wait(strm)) + +@stream_close_ok = λstrm. + %stream_close(strm) + +@list_rev = λxs. + @list_rev_go(xs, []) + +@list_rev_go = λxs. λ&acc. + λ{ + []: acc; + <>: λh. λt.@list_rev_go(t, h <> acc); + &{} + }(xs) + +@stream_read_all = λstrm. + @stream_read_all_go(strm, []) + +@stream_read_all_go = λstrm. λ&acc. + ! f0 = λ w ; + @do_ok( + [ + f0, @stream_wait_ok(strm) + ], + !&wr = w; + !&h = @fst(wr); + ! e = @snd(wr); + !&a = acc; + λ{ + #BYT: λn.@stream_read_all_go(h, #BYT{n} <> a); + #Eof: @pure(#Pack{h, @list_rev(a)}); + &{} + }(e) + ) + +@stream_close_and_take = λr1. + !&r = r1; + ! h = @fst(r); + ! b = @snd(r); + ! f0 = λ c0 ; + @do_ok( + [ + f0, @stream_close_ok(h) + ], + b + ) + +@stream_file_read_all = λpath. + ! f0 = λ s0 ; + ! f1 = λ r1 ; + ! f2 = λ b2 ; + @do_ok( + [ + f0, @stream_file_open_ok(path), + f1, @stream_read_all(s0), + f2, @stream_close_and_take(r1) + ], + b2 + ) + +// ----------------------------------------------------------------------------- +// HTTP +// ----------------------------------------------------------------------------- + +@http_opts_default = + #Opts{5000,2000,#F{},0,#T{},65536} + +@http_req = λmethod. λurl. λheaders. λbody. λopts. + #Req{method,url,headers,body,opts} + +@http_get_req = λurl. + #Req{#Get{},url,[],#NoBody{},@http_opts_default} + +@http_post_text_req = λurl. λtext. + #Req{#Post{},url,[],#BodyText{text},@http_opts_default} + +@http_post_bytes_req = λurl. λbbs. + #Req{#Post{},url,[],#BodyBytes{bbs},@http_opts_default} + +@http_request_ok = λreq. + %http_request(req) + +@http_poll_ok = λhttp. + %http_poll(http) + +@http_wait_ok = λhttp. + @wait2(%http_wait(http)) + +@http_cancel_ok = λhttp. + %http_cancel(http) + +@http_request_wait = λreq. + ! f0 = λ h0 ; + ! f1 = λ w1 ; + @do_ok( + [ + f0, @http_request_ok(req), + f1, @http_wait_ok(h0) + ], + @snd(w1) + ) + +@http_get = λurl. + @http_request_wait(@http_get_req(url)) + +@http_post_text = λurl. λtext. + @http_request_wait(@http_post_text_req(url, text)) + +@http_post_bytes = λurl. λbbs. + @http_request_wait(@http_post_bytes_req(url, bbs)) + +// ----------------------------------------------------------------------------- +// TCP +// ----------------------------------------------------------------------------- + +@tcp_opts_default = + #TcpOpts{5000,5000,5000,#T{},#F{}} + +@tcp_req = λhost. λport. λopts. + #TcpReq{host,port,opts} + +@tcp_connect_ok = λreq. + %tcp_connect(req) + +@tcp_connect_poll_ok = λtcp. + %tcp_connect_poll(tcp) + +@tcp_connect_wait_ok = λtcp. + @wait2(%tcp_connect_wait(tcp)) + +@tcp_send_poll_ok = λtcp. λdata. + %tcp_send_poll(tcp, data) + +@tcp_send_wait_ok = λtcp. λdata. + @wait2(%tcp_send_wait(tcp, data)) + +@tcp_recv_poll_ok = λtcp. λmaxb. + %tcp_recv_poll(tcp, maxb) + +@tcp_recv_wait_ok = λtcp. λmaxb. + @wait2(%tcp_recv_wait(tcp, maxb)) + +@tcp_close_ok = λtcp. + @wait2(%tcp_close(tcp)) + +@tcp_expect_conn = λw1. + !&w = w1; + ! h = @fst(w); + λ{ + #Conn: @pure(h); + #Fail: λreason. λmsg.#ERR{msg}; + &{} + }(@snd(w)) + +@tcp_connect_open = λreq. + ! f0 = λ t0 ; + ! f1 = λ w1 ; + ! f2 = λ h2 ; + @do_ok( + [ + f0, @tcp_connect_ok(req), + f1, @tcp_connect_wait_ok(t0), + f2, @tcp_expect_conn(w1) + ], + h2 + ) + +@tcp_step_send = λw1. λdata. + !&p = w1; + ! h1 = @fst(p); + ! cevt = @snd(p); + ! f0 = λ w2 ; + @do_ok( + [ + f0, @tcp_send_wait_ok(h1, data) + ], + #Pack{w2, cevt} + ) + +@tcp_step_recv = λst. λmaxb. + !&s = st; + ! w2 = @fst(s); + ! cevt = @snd(s); + !&q = w2; + ! h2 = @fst(q); + ! sevt = @snd(q); + ! f0 = λ w3 ; + @do_ok( + [ + f0, @tcp_recv_wait_ok(h2, maxb) + ], + #Pack{w3, #Pack{cevt,sevt}} + ) + +@tcp_step_close = λst. + !&s = st; + ! w3 = @fst(s); + ! pair = @snd(s); + !&q = w3; + ! h3 = @fst(q); + ! revt = @snd(q); + !&r = pair; + ! cevt = @fst(r); + ! sevt = @snd(r); + ! f0 = λ w4 ; + @do_ok( + [ + f0, @tcp_close_ok(h3) + ], + #Pack{cevt, #Pack{sevt, revt}} + ) + +@tcp_roundtrip = λreq. λdata. λmaxb. + ! f0 = λ t0 ; + ! f1 = λ w1 ; + ! f2 = λ st2 ; + ! f3 = λ st3 ; + ! f4 = λ out ; + @do_ok( + [ + f0, @tcp_connect_ok(req), + f1, @tcp_connect_wait_ok(t0), + f2, @tcp_step_send(w1, data), + f3, @tcp_step_recv(st2, maxb), + f4, @tcp_step_close(st3) + ], + out + ) + +// ----------------------------------------------------------------------------- +// File + System Convenience +// ----------------------------------------------------------------------------- + +@fs_read_text = λpath. + %read_file(path) + +@fs_read_bytes = λpath. + %read_bytes(path) + +@fs_write_text = λpath. λtext. + %write_file(path, text) + +@fs_write_bytes = λpath. λdata. + %write_bytes(path, data) + +@env_get = λname. + %env(name) + +@cwd_get = + %cwd(0) + +@chdir_ok = λpath. + %chdir(path) + +@argv = + %argv(0) + +@uid = + %uid(0) + +@rand = + %rand(0) + +@uuid_ok = + %uuid(0) + +@argv_ok = + @pure(@argv) + +@uid_ok = + @pure(@uid) + +@rand_ok = + @pure(@rand) + +@abort = λmsg. + %panic(msg) From 2c20334ab8e2f9761f4799510ef0bccde7a7b681 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Mon, 16 Feb 2026 08:08:02 -0300 Subject: [PATCH 29/35] examples --- examples/http_get_basic.hvm4 | 37 ++++++++++++++++++ examples/process_run_exit.hvm4 | 17 +++++++++ examples/process_timeout_kill.hvm4 | 36 ++++++++++++++++++ examples/sample.txt | 2 + examples/stream_file_read_all.hvm4 | 52 +++++++++++++++++++++++++ examples/stream_stdin_line.hvm4 | 59 +++++++++++++++++++++++++++++ examples/tcp_echo_client.hvm4 | 37 ++++++++++++++++++ examples/timer_sleep_and_ticks.hvm4 | 32 ++++++++++++++++ 8 files changed, 272 insertions(+) create mode 100644 examples/http_get_basic.hvm4 create mode 100644 examples/process_run_exit.hvm4 create mode 100644 examples/process_timeout_kill.hvm4 create mode 100644 examples/sample.txt create mode 100644 examples/stream_file_read_all.hvm4 create mode 100644 examples/stream_stdin_line.hvm4 create mode 100644 examples/tcp_echo_client.hvm4 create mode 100644 examples/timer_sleep_and_ticks.hvm4 diff --git a/examples/http_get_basic.hvm4 b/examples/http_get_basic.hvm4 new file mode 100644 index 00000000..bafd942c --- /dev/null +++ b/examples/http_get_basic.hvm4 @@ -0,0 +1,37 @@ +#include "../stdlib/all.hvm4" + +// Performs GET on example.com and returns #P{status, decoded_body}. +// Requires outbound network access. + +@resp_to_status_body = λev. + λ{ + #Resp: λstatus. λheaders. λbody.@pure(#P{status, body}); + #Fail: λreason. λmsg.#ERR{msg}; + #Canceled: #ERR{"http request canceled"}; + &{} + }(ev) + +@decode_status_text = λsb1. + !&sb = sb1; + ! st = @fst(sb); + ! bs = @snd(sb); + ! f0 = λ txt ; + @do( + [ + f0, @bytes_to_string(bs) + ], + #P{st, txt} + ) + +@main = + ! f0 = λ ev0 ; + ! f1 = λ sb1 ; + ! f2 = λ out2 ; + @do( + [ + f0, @http_get("https://example.com"), + f1, @resp_to_status_body(ev0), + f2, @decode_status_text(sb1) + ], + out2 + ) diff --git a/examples/process_run_exit.hvm4 b/examples/process_run_exit.hvm4 new file mode 100644 index 00000000..ec5e139e --- /dev/null +++ b/examples/process_run_exit.hvm4 @@ -0,0 +1,17 @@ +#include "../stdlib/process.hvm4" + +// Runs 3 commands and returns their process events. +// Expected events: #Exit{0}, #Exit{7}, #Exit{1}. + +@main = + ! f0 = λ e0 ; + ! f1 = λ e1 ; + ! f2 = λ e2 ; + @do( + [ + f0, @process_run("exit 0"), + f1, @process_run("exit 7"), + f2, @process_run("false") + ], + #P{e0, #P{e1, e2}} + ) diff --git a/examples/process_timeout_kill.hvm4 b/examples/process_timeout_kill.hvm4 new file mode 100644 index 00000000..ebb4d7d3 --- /dev/null +++ b/examples/process_timeout_kill.hvm4 @@ -0,0 +1,36 @@ +#include "../stdlib/all.hvm4" + +// Starts a long process, waits timeout_ms, then kills it. + +@process_kill_wait = λproc. + ! f0 = λ st ; + ! f1 = λ kw ; + @do( + [ + f0, @process_kill(proc), + f1, λ{ + #Rdy: λp2. λev.@pure(#P{p2, ev}); + #Pend: λp2.@process_wait(p2); + &{} + }(st) + ], + kw + ) + +@run_with_timeout = λcmd. λtimeout_ms. + ! f0 = λ p0 ; + ! f1 = λ t0 ; + ! f2 = λ tw ; + ! f3 = λ kw ; + @do( + [ + f0, @process_spawn(cmd), + f1, @timer_start(timeout_ms), + f2, @timer_wait(t0), + f3, @process_kill_wait(p0) + ], + #P{tw, kw} + ) + +@main = + @run_with_timeout("sleep 10", 1000) diff --git a/examples/sample.txt b/examples/sample.txt new file mode 100644 index 00000000..363dfc52 --- /dev/null +++ b/examples/sample.txt @@ -0,0 +1,2 @@ +Hello from HVM4 examples. +This file is read as bytes and decoded with stdlib/bytes.hvm4. diff --git a/examples/stream_file_read_all.hvm4 b/examples/stream_file_read_all.hvm4 new file mode 100644 index 00000000..6fd2285d --- /dev/null +++ b/examples/stream_file_read_all.hvm4 @@ -0,0 +1,52 @@ +#include "../stdlib/all.hvm4" + +// Reads an entire file via stream, closes it, and decodes UTF-8. + +@stream_read_all_step = λw. λ&acc. + !&w2 = w; + !&h = @fst(w2); + ! e = @snd(w2); + λ{ + #BYT: λn.@stream_read_all(h, #BYT{n} <> acc); + #Eof: @pure(#P{h, @list_rev(acc)}); + &{} + }(e) + +@stream_read_all = λstrm. λ&acc. + ! f0 = λ w0 ; + ! f1 = λ r1 ; + @do( + [ + f0, @stream_wait(strm), + f1, @stream_read_all_step(w0, acc) + ], + r1 + ) + +@stream_close_decode = λr1. + !&r = r1; + ! f0 = λ c2 ; + ! f1 = λ txt ; + @do( + [ + f0, @stream_close(@fst(r)), + f1, @bytes_to_string(@snd(r)) + ], + txt + ) + +@stream_file_read_all = λpath. + ! f0 = λ s0 ; + ! f1 = λ r1 ; + ! f2 = λ txt ; + @do( + [ + f0, @stream_file_open(path), + f1, @stream_read_all(s0, []), + f2, @stream_close_decode(r1) + ], + txt + ) + +@main = + @stream_file_read_all("examples/sample.txt") diff --git a/examples/stream_stdin_line.hvm4 b/examples/stream_stdin_line.hvm4 new file mode 100644 index 00000000..5afb681c --- /dev/null +++ b/examples/stream_stdin_line.hvm4 @@ -0,0 +1,59 @@ +#include "../stdlib/all.hvm4" + +// Reads one line from stdin (until '\n'), closes stream, decodes UTF-8. + +@stream_read_line_step = λw. λ&acc. + !&w2 = w; + !&h = @fst(w2); + ! e = @snd(w2); + λ{ + #BYT: λn. + λ{ + 10: + @pure(#P{h, @list_rev(acc)}); + λx. + @stream_read_line(h, #BYT{x} <> acc) + }(n); + #Eof: + @pure(#P{h, @list_rev(acc)}); + &{} + }(e) + +@stream_read_line = λstrm. λ&acc. + ! f0 = λ w0 ; + ! f1 = λ r1 ; + @do( + [ + f0, @stream_wait(strm), + f1, @stream_read_line_step(w0, acc) + ], + r1 + ) + +@stream_close_decode = λr1. + !&r = r1; + ! f0 = λ c2 ; + ! f1 = λ txt ; + @do( + [ + f0, @stream_close(@fst(r)), + f1, @bytes_to_string(@snd(r)) + ], + txt + ) + +@stdin_read_line = + ! f0 = λ s0 ; + ! f1 = λ r1 ; + ! f2 = λ txt ; + @do( + [ + f0, @stream_stdin_open(0), + f1, @stream_read_line(s0, []), + f2, @stream_close_decode(r1) + ], + txt + ) + +@main = + @stdin_read_line diff --git a/examples/tcp_echo_client.hvm4 b/examples/tcp_echo_client.hvm4 new file mode 100644 index 00000000..66ea6c41 --- /dev/null +++ b/examples/tcp_echo_client.hvm4 @@ -0,0 +1,37 @@ +#include "../stdlib/all.hvm4" + +// Connects to localhost:9090, sends "ping\n", waits reply, closes socket. +// Requires an echo server running on 127.0.0.1:9090. + +@decode_recv_evt = λev. + λ{ + #Recv: λbs.@bytes_to_string(bs); + #Eof: @pure(""); + #Fail: λreason. λmsg.#ERR{msg}; + &{} + }(ev) + +@decode_roundtrip = λout0. + !&o = out0; + ! p = @snd(o); + ! recv_evt = @snd(p); + ! f0 = λ txt ; + @do( + [ + f0, @decode_recv_evt(recv_evt) + ], + #P{o, txt} + ) + +@main = + ! req = @tcp_req("127.0.0.1", 9090, @tcp_opts_default); + ! payload = [#BYT{112}, #BYT{105}, #BYT{110}, #BYT{103}, #BYT{10}]; + ! f0 = λ out0 ; + ! f1 = λ out1 ; + @do( + [ + f0, @tcp_roundtrip(req, payload, 128), + f1, @decode_roundtrip(out0) + ], + out1 + ) diff --git a/examples/timer_sleep_and_ticks.hvm4 b/examples/timer_sleep_and_ticks.hvm4 new file mode 100644 index 00000000..cdb4f9e6 --- /dev/null +++ b/examples/timer_sleep_and_ticks.hvm4 @@ -0,0 +1,32 @@ +#include "../stdlib/timer.hvm4" + +// Logs "tick" every second, 5 times. + +@ticks = λn. λ&ms. + λ{ + 0: + @pure(#Done{}); + λk. + ! f0 = λ s0 ; + ! f1 = λ l1 ; + ! f2 = λ r2 ; + @do( + [ + f0, @sleep_ms(ms), + f1, @log("tick"), + f2, @ticks(k - 1, ms) + ], + r2 + ) + }(n) + +@main = + ! f0 = λ l0 ; + ! f1 = λ r1 ; + @do( + [ + f0, @log("starting timer example"), + f1, @ticks(5, 1000) + ], + r1 + ) From b97d4e6768fa675dda45987bf5af19f83451b1df Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Mon, 16 Feb 2026 08:08:09 -0300 Subject: [PATCH 30/35] stdlib --- stdlib/_.hvm4 | 150 ++++++++++++++++++++++++++++++++++++++++++ stdlib/all.hvm4 | 9 +++ stdlib/bytes.hvm4 | 156 ++++++++++++++++++++++++++++++++++++++++++++ stdlib/fs.hvm4 | 15 +++++ stdlib/http.hvm4 | 50 ++++++++++++++ stdlib/os.hvm4 | 27 ++++++++ stdlib/process.hvm4 | 35 ++++++++++ stdlib/stream.hvm4 | 63 ++++++++++++++++++ stdlib/tcp.hvm4 | 117 +++++++++++++++++++++++++++++++++ stdlib/timer.hvm4 | 26 ++++++++ 10 files changed, 648 insertions(+) create mode 100644 stdlib/_.hvm4 create mode 100644 stdlib/all.hvm4 create mode 100644 stdlib/bytes.hvm4 create mode 100644 stdlib/fs.hvm4 create mode 100644 stdlib/http.hvm4 create mode 100644 stdlib/os.hvm4 create mode 100644 stdlib/process.hvm4 create mode 100644 stdlib/stream.hvm4 create mode 100644 stdlib/tcp.hvm4 create mode 100644 stdlib/timer.hvm4 diff --git a/stdlib/_.hvm4 b/stdlib/_.hvm4 new file mode 100644 index 00000000..9d113a32 --- /dev/null +++ b/stdlib/_.hvm4 @@ -0,0 +1,150 @@ +// HVM4 stdlib core +// - Result combinators +// - Generic do-notation interpreter +// - Wait/poll normalization helpers +// - Generic list helpers + +// ----------------------------------------------------------------------------- +// Result Core +// ----------------------------------------------------------------------------- + +@pure = λx.#OK{x} +@ok = @pure + +@fail = λmsg.#ERR{msg} + +@bind = λr. λk. + λ{ + #OK: λx.k(x); + #ERR: λe.#ERR{e}; + &{} + }(r) + +@then = λr. λnext. + @bind(r, λu.next) + +@map = λr. λf. + @bind(r, λx.@pure(f(x))) + +@map_err = λr. λf. + λ{ + #OK: λx.#OK{x}; + #ERR: λe.#ERR{f(e)}; + &{} + }(r) + +@or_else = λr. λkerr. + λ{ + #OK: λx.#OK{x}; + #ERR: λe.kerr(e); + &{} + }(r) + +@log = λmsg. + @pure(%log(msg)) + +@fst = λp. + λ{ + #P: λa. λb.a; + &{} + }(p) + +@snd = λp. + λ{ + #P: λa. λb.b; + &{} + }(p) + +@dup2 = λx. λk. + !d&D = x; + k(d₀, d₁) + +// ----------------------------------------------------------------------------- +// Do Notation Core +// ----------------------------------------------------------------------------- + +// @do_with(bind, pure, steps, cont) +// steps format: [wrap0, action0, wrap1, action1, ...] +// wrapN is an unscoped wrapper built with: ! f = λ x ; ... +@do_with = λ&bind. λ&pure. λsteps. λ&cont. + λ{ + []: pure(cont); + <>: λwrap. λtail. + λ{ + <>: λact. λrest. + bind(act, λv. + λ{ + #P: λrest2. λcont2. + @do_with(bind, pure, rest2, cont2); + &{} + }(wrap(#P{rest,cont})(v)) + ); + []: + #ERR{"do: malformed steps; expected [wrap,action,...]"} + }(tail) + }(steps) + +@do = λsteps. λcont. + @do_with(@bind, @pure, steps, cont) + +// ----------------------------------------------------------------------------- +// Wait/Poll Normalization +// ----------------------------------------------------------------------------- + +@wait = λr. λdecode. + @bind(r, λst.decode(st)) + +@decode_wait_h = λst. + λ{ + #Rdy: λh.@pure(h); + #Pend: λh.#ERR{"expected #Rdy; got #Pend"}; + &{} + }(st) + +@decode_wait_he = λst. + λ{ + #Rdy: λh. λe.@pure(#P{h,e}); + #Pend: λh.#ERR{"expected #Rdy; got #Pend"}; + &{} + }(st) + +@decode_poll_h = λst. + λ{ + #Pend: λh.@pure(#Pend{h}); + #Rdy: λh.@pure(#Rdy{h}); + &{} + }(st) + +@decode_poll_he = λst. + λ{ + #Pend: λh.@pure(#Pend{h}); + #Rdy: λh. λe.@pure(#Rdy{#P{h,e}}); + &{} + }(st) + +@await_poll = λ&poll. λ&decode. λh0. + ! f0 = λ st ; + @do( + [ + f0, @wait(poll(h0), decode) + ], + λ{ + #Pend: λh1.@await_poll(poll, decode, h1); + #Rdy: λout.@pure(out); + &{} + }(st) + ) + +// ----------------------------------------------------------------------------- +// Generic Lists +// ----------------------------------------------------------------------------- + +@list_rev = λxs. + @list_rev_go(xs, []) + +@list_rev_go = λxs. λ&acc. + λ{ + []: acc; + <>: λh. λt.@list_rev_go(t, h <> acc); + &{} + }(xs) diff --git a/stdlib/all.hvm4 b/stdlib/all.hvm4 new file mode 100644 index 00000000..ef0985be --- /dev/null +++ b/stdlib/all.hvm4 @@ -0,0 +1,9 @@ +#include "_.hvm4" +#include "bytes.hvm4" +#include "timer.hvm4" +#include "process.hvm4" +#include "stream.hvm4" +#include "http.hvm4" +#include "tcp.hvm4" +#include "fs.hvm4" +#include "os.hvm4" diff --git a/stdlib/bytes.hvm4 b/stdlib/bytes.hvm4 new file mode 100644 index 00000000..575778b4 --- /dev/null +++ b/stdlib/bytes.hvm4 @@ -0,0 +1,156 @@ +#include "_.hvm4" + +// Byte helpers +// - UTF-8 decode from List<#BYT{n}> to String (List<#CHR{codepoint}>) + +@bytes_if = λcond. λyes. λno. + λ{ + 0: no; + λx.yes + }(cond) + +@bytes_is_cont = λ&b. + ((b >= 128) && (b <= 191)) + +@bytes_valid_b1_3 = λ&b0. λ&b1. + @bytes_if( + (b0 == 224), + ((b1 >= 160) && (b1 <= 191)), + @bytes_if( + (b0 == 237), + ((b1 >= 128) && (b1 <= 159)), + @bytes_is_cont(b1) + ) + ) + +@bytes_valid_b1_4 = λ&b0. λ&b1. + @bytes_if( + (b0 == 240), + ((b1 >= 144) && (b1 <= 191)), + @bytes_if( + (b0 == 244), + ((b1 >= 128) && (b1 <= 143)), + @bytes_is_cont(b1) + ) + ) + +@bytes_to_string = λbytes. + @bytes_to_string_go(bytes, []) + +@bytes_to_string_go = λbytes. λ&acc. + λ{ + []: + @pure(@list_rev(acc)); + <>: λhead. λ&tail. + λ{ + #BYT: λ&b0. + @bytes_if( + (b0 <= 127), + @bytes_to_string_go(tail, #CHR{b0} <> acc), + @bytes_if( + ((b0 >= 194) && (b0 <= 223)), + @bytes_to_string_2(b0, tail, acc), + @bytes_if( + ((b0 >= 224) && (b0 <= 239)), + @bytes_to_string_3(b0, tail, acc), + @bytes_if( + ((b0 >= 240) && (b0 <= 244)), + @bytes_to_string_4(b0, tail, acc), + @fail("bytes_to_string: invalid UTF-8 leading byte") + ) + ) + ) + ); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(head); + &{} + }(bytes) + +@bytes_to_string_2 = λ&b0. λtail. λ&acc. + λ{ + []: + @fail("bytes_to_string: truncated UTF-8 sequence"); + <>: λh1. λrest. + λ{ + #BYT: λ&b1. + @bytes_if( + @bytes_is_cont(b1), + ! cp = (((b0 - 192) << 6) + (b1 - 128)); + @bytes_to_string_go(rest, #CHR{cp} <> acc), + @fail("bytes_to_string: invalid UTF-8 continuation byte") + ); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(h1); + &{} + }(tail) + +@bytes_to_string_3 = λ&b0. λtail. λ&acc. + λ{ + []: + @fail("bytes_to_string: truncated UTF-8 sequence"); + <>: λh1. λtail2. + λ{ + #BYT: λ&b1. + λ{ + []: + @fail("bytes_to_string: truncated UTF-8 sequence"); + <>: λh2. λrest. + λ{ + #BYT: λ&b2. + @bytes_if( + (@bytes_valid_b1_3(b0, b1) && @bytes_is_cont(b2)), + ! cp = ((((b0 - 224) << 12) + ((b1 - 128) << 6)) + (b2 - 128)); + @bytes_to_string_go(rest, #CHR{cp} <> acc), + @fail("bytes_to_string: invalid UTF-8 continuation byte") + ); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(h2); + &{} + }(tail2); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(h1); + &{} + }(tail) + +@bytes_to_string_4 = λ&b0. λtail. λ&acc. + λ{ + []: + @fail("bytes_to_string: truncated UTF-8 sequence"); + <>: λh1. λtail2. + λ{ + #BYT: λ&b1. + λ{ + []: + @fail("bytes_to_string: truncated UTF-8 sequence"); + <>: λh2. λtail3. + λ{ + #BYT: λ&b2. + λ{ + []: + @fail("bytes_to_string: truncated UTF-8 sequence"); + <>: λh3. λrest. + λ{ + #BYT: λ&b3. + @bytes_if( + ((@bytes_valid_b1_4(b0, b1) && @bytes_is_cont(b2)) && @bytes_is_cont(b3)), + ! cp = (((((b0 - 240) << 18) + ((b1 - 128) << 12)) + ((b2 - 128) << 6)) + (b3 - 128)); + @bytes_to_string_go(rest, #CHR{cp} <> acc), + @fail("bytes_to_string: invalid UTF-8 continuation byte") + ); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(h3); + &{} + }(tail3); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(h2); + &{} + }(tail2); + λx.@fail("bytes_to_string: expected List<#BYT{n}>") + }(h1); + &{} + }(tail) + +@bytes_log = λbytes. + @bind(@bytes_to_string(bytes), λtxt. + @log(txt) + ) diff --git a/stdlib/fs.hvm4 b/stdlib/fs.hvm4 new file mode 100644 index 00000000..b503082e --- /dev/null +++ b/stdlib/fs.hvm4 @@ -0,0 +1,15 @@ +#include "_.hvm4" + +// File system helpers + +@fs_read_text = λpath. + %read_file(path) + +@fs_read_bytes = λpath. + %read_bytes(path) + +@fs_write_text = λpath. λtext. + %write_file(path, text) + +@fs_write_bytes = λpath. λdata. + %write_bytes(path, data) diff --git a/stdlib/http.hvm4 b/stdlib/http.hvm4 new file mode 100644 index 00000000..dcd4a7e0 --- /dev/null +++ b/stdlib/http.hvm4 @@ -0,0 +1,50 @@ +#include "_.hvm4" + +// HTTP helpers + +@http_opts_default = + #Opts{5000,2000,#F{},0,#T{},65536} + +@http_req = λmethod. λurl. λheaders. λbody. λopts. + #Req{method,url,headers,body,opts} + +@http_get_req = λurl. + #Req{#Get{},url,[],#NoBody{},@http_opts_default} + +@http_post_text_req = λurl. λtext. + #Req{#Post{},url,[],#BodyText{text},@http_opts_default} + +@http_post_bytes_req = λurl. λbbs. + #Req{#Post{},url,[],#BodyBytes{bbs},@http_opts_default} + +@http_request = λreq. + %http_request(req) + +@http_poll = λhttp. + %http_poll(http) + +@http_wait = λhttp. + @wait(%http_wait(http), @decode_wait_he) + +@http_cancel = λhttp. + %http_cancel(http) + +@http_request_wait = λreq. + ! f0 = λ h0 ; + ! f1 = λ w1 ; + @do( + [ + f0, @http_request(req), + f1, @http_wait(h0) + ], + @snd(w1) + ) + +@http_get = λurl. + @http_request_wait(@http_get_req(url)) + +@http_post_text = λurl. λtext. + @http_request_wait(@http_post_text_req(url, text)) + +@http_post_bytes = λurl. λbbs. + @http_request_wait(@http_post_bytes_req(url, bbs)) diff --git a/stdlib/os.hvm4 b/stdlib/os.hvm4 new file mode 100644 index 00000000..09920250 --- /dev/null +++ b/stdlib/os.hvm4 @@ -0,0 +1,27 @@ +#include "_.hvm4" + +// OS / environment helpers + +@env_get = λname. + %env(name) + +@cwd_get = + %cwd(0) + +@chdir = λpath. + %chdir(path) + +@argv = + @pure(%argv(0)) + +@uid = + @pure(%uid(0)) + +@rand = + @pure(%rand(0)) + +@uuid = + %uuid(0) + +@abort = λmsg. + %panic(msg) diff --git a/stdlib/process.hvm4 b/stdlib/process.hvm4 new file mode 100644 index 00000000..d192d621 --- /dev/null +++ b/stdlib/process.hvm4 @@ -0,0 +1,35 @@ +#include "_.hvm4" + +// Process helpers + +@process_spawn = λcmd. + %process_spawn(cmd) + +@process_poll = λproc. + %process_poll(proc) + +@process_wait = λproc. + @wait(%process_wait(proc), @decode_wait_he) + +@process_wait_evt = λproc. + ! f0 = λ w0 ; + @do( + [ + f0, @process_wait(proc) + ], + @snd(w0) + ) + +@process_kill = λproc. + %process_kill(proc) + +@process_run = λcmd. + ! f0 = λ p0 ; + ! f1 = λ e1 ; + @do( + [ + f0, @process_spawn(cmd), + f1, @process_wait_evt(p0) + ], + e1 + ) diff --git a/stdlib/stream.hvm4 b/stdlib/stream.hvm4 new file mode 100644 index 00000000..092dc6bb --- /dev/null +++ b/stdlib/stream.hvm4 @@ -0,0 +1,63 @@ +#include "_.hvm4" + +// Stream helpers + +@stream_stdin_open = λseed. + %stream_stdin_open(seed) + +@stream_file_open = λpath. + %stream_file_open(path) + +@stream_poll = λstrm. + %stream_poll(strm) + +@stream_wait = λstrm. + @wait(%stream_wait(strm), @decode_wait_he) + +@stream_close = λstrm. + %stream_close(strm) + +@stream_read_all = λstrm. + @stream_read_all_go(strm, []) + +@stream_read_all_go = λstrm. λ&acc. + ! f0 = λ w ; + @do( + [ + f0, @stream_wait(strm) + ], + !&wr = w; + !&h = @fst(wr); + ! e = @snd(wr); + !&a = acc; + λ{ + #BYT: λn.@stream_read_all_go(h, #BYT{n} <> a); + #Eof: @pure(#P{h, @list_rev(a)}); + &{} + }(e) + ) + +@stream_close_and_take = λr1. + !&r = r1; + ! h = @fst(r); + ! b = @snd(r); + ! f0 = λ c0 ; + @do( + [ + f0, @stream_close(h) + ], + b + ) + +@stream_file_read_all = λpath. + ! f0 = λ s0 ; + ! f1 = λ r1 ; + ! f2 = λ b2 ; + @do( + [ + f0, @stream_file_open(path), + f1, @stream_read_all(s0), + f2, @stream_close_and_take(r1) + ], + b2 + ) diff --git a/stdlib/tcp.hvm4 b/stdlib/tcp.hvm4 new file mode 100644 index 00000000..dff2e240 --- /dev/null +++ b/stdlib/tcp.hvm4 @@ -0,0 +1,117 @@ +#include "_.hvm4" + +// TCP helpers + +@tcp_opts_default = + #TcpOpts{5000,5000,5000,#T{},#F{}} + +@tcp_req = λhost. λport. λopts. + #TcpReq{host,port,opts} + +@tcp_connect = λreq. + %tcp_connect(req) + +@tcp_connect_poll = λtcp. + %tcp_connect_poll(tcp) + +@tcp_connect_wait = λtcp. + @wait(%tcp_connect_wait(tcp), @decode_wait_he) + +@tcp_send_poll = λtcp. λdata. + %tcp_send_poll(tcp, data) + +@tcp_send_wait = λtcp. λdata. + @wait(%tcp_send_wait(tcp, data), @decode_wait_he) + +@tcp_recv_poll = λtcp. λmaxb. + %tcp_recv_poll(tcp, maxb) + +@tcp_recv_wait = λtcp. λmaxb. + @wait(%tcp_recv_wait(tcp, maxb), @decode_wait_he) + +@tcp_close = λtcp. + @wait(%tcp_close(tcp), @decode_wait_he) + +@tcp_expect_conn = λw1. + !&w = w1; + ! h = @fst(w); + λ{ + #Conn: @pure(h); + #Fail: λreason. λmsg.#ERR{msg}; + &{} + }(@snd(w)) + +@tcp_connect_open = λreq. + ! f0 = λ t0 ; + ! f1 = λ w1 ; + ! f2 = λ h2 ; + @do( + [ + f0, @tcp_connect(req), + f1, @tcp_connect_wait(t0), + f2, @tcp_expect_conn(w1) + ], + h2 + ) + +@tcp_step_send = λw1. λdata. + !&p = w1; + ! h1 = @fst(p); + ! cevt = @snd(p); + ! f0 = λ w2 ; + @do( + [ + f0, @tcp_send_wait(h1, data) + ], + #P{w2, cevt} + ) + +@tcp_step_recv = λst. λmaxb. + !&s = st; + ! w2 = @fst(s); + ! cevt = @snd(s); + !&q = w2; + ! h2 = @fst(q); + ! sevt = @snd(q); + ! f0 = λ w3 ; + @do( + [ + f0, @tcp_recv_wait(h2, maxb) + ], + #P{w3, #P{cevt,sevt}} + ) + +@tcp_step_close = λst. + !&s = st; + ! w3 = @fst(s); + ! pair = @snd(s); + !&q = w3; + ! h3 = @fst(q); + ! revt = @snd(q); + !&r = pair; + ! cevt = @fst(r); + ! sevt = @snd(r); + ! f0 = λ w4 ; + @do( + [ + f0, @tcp_close(h3) + ], + #P{cevt, #P{sevt, revt}} + ) + +@tcp_roundtrip = λreq. λdata. λmaxb. + ! f0 = λ t0 ; + ! f1 = λ w1 ; + ! f2 = λ st2 ; + ! f3 = λ st3 ; + ! f4 = λ out ; + @do( + [ + f0, @tcp_connect(req), + f1, @tcp_connect_wait(t0), + f2, @tcp_step_send(w1, data), + f3, @tcp_step_recv(st2, maxb), + f4, @tcp_step_close(st3) + ], + out + ) diff --git a/stdlib/timer.hvm4 b/stdlib/timer.hvm4 new file mode 100644 index 00000000..6901638e --- /dev/null +++ b/stdlib/timer.hvm4 @@ -0,0 +1,26 @@ +#include "_.hvm4" + +// Timer helpers + +@timer_start = λms. + %timer_start(ms) + +@timer_poll = λt. + %timer_poll(t) + +@timer_wait = λt. + @wait(%timer_wait(t), @decode_wait_h) + +@sleep_ms = λms. + ! f0 = λ t0 ; + ! f1 = λ t1 ; + @do( + [ + f0, @timer_start(ms), + f1, @timer_wait(t0) + ], + [] + ) + +@sleep_s = λsec. + @sleep_ms(sec * 1000) From 41e4b59d59c7923968fbd8e407ecd4b31d29e46a Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Mon, 16 Feb 2026 08:08:20 -0300 Subject: [PATCH 31/35] stdlib --- stdlib.hvm4 | 502 +--------------------------------------------------- 1 file changed, 2 insertions(+), 500 deletions(-) diff --git a/stdlib.hvm4 b/stdlib.hvm4 index 35308d95..253c4dec 100644 --- a/stdlib.hvm4 +++ b/stdlib.hvm4 @@ -1,500 +1,2 @@ -// HVM4 stdlib helpers -// - Result combinators -// - Generic do-notation interpreter (flat steps) -// - Async wrappers (timer/process/stream/http/tcp) -// - File/system convenience wrappers - -// ----------------------------------------------------------------------------- -// Result Core -// ----------------------------------------------------------------------------- - -@pure = λx.#OK{x} -@ok = @pure - -@fail = λmsg.#ERR{msg} - -@bind = λr. λk. - λ{ - #OK: λx.k(x); - #ERR: λe.#ERR{e}; - &{} - }(r) - -@then = λr. λnext. - @bind(r, λu.next) - -@map = λr. λf. - @bind(r, λx.@pure(f(x))) - -@map_err = λr. λf. - λ{ - #OK: λx.#OK{x}; - #ERR: λe.#ERR{f(e)}; - &{} - }(r) - -@or_else = λr. λkerr. - λ{ - #OK: λx.#OK{x}; - #ERR: λe.kerr(e); - &{} - }(r) - -@log_ok = λmsg. - @pure(%log(msg)) - -@fst = λp. - λ{ - #Pack: λa. λb.a; - &{} - }(p) - -@snd = λp. - λ{ - #Pack: λa. λb.b; - &{} - }(p) - -@dup2 = λx. λk. - !d&D = x; - k(d₀, d₁) - -// ----------------------------------------------------------------------------- -// Do Notation Core -// ----------------------------------------------------------------------------- - -// @do(bind, pure, steps, cont) -// steps format: [wrap0, action0, wrap1, action1, ...] -// wrapN is an unscoped wrapper built with: ! f = λ x ; ... -@do = λ&bind. λ&pure. λsteps. λ&cont. - λ{ - []: pure(cont); - <>: λwrap. λtail. - λ{ - <>: λact. λrest. - bind(act, λv. - λ{ - #Pack: λrest2. λcont2. - @do(bind, pure, rest2, cont2); - &{} - }(wrap(#Pack{rest,cont})(v)) - ); - []: - #ERR{"do: malformed steps; expected [wrap,action,...]"} - }(tail) - }(steps) - -@do_ok = λsteps. λcont. - @do(@bind, @pure, steps, cont) - -// ----------------------------------------------------------------------------- -// Wait/Poll Normalization -// ----------------------------------------------------------------------------- - -// #OK{#Rdy{h}} | #ERR{...} -@wait1 = λr. - @bind(r, λrd. - λ{ - #Rdy: λh.@pure(h); - #Pend: λh.#ERR{"expected #Rdy; got #Pend"}; - &{} - }(rd) - ) - -// #OK{#Rdy{h,e}} | #ERR{...} -@wait2 = λr. - @bind(r, λrd. - λ{ - #Rdy: λh. λe.@pure(#Pack{h,e}); - #Pend: λh.#ERR{"expected #Rdy; got #Pend"}; - &{} - }(rd) - ) - -// passthrough normalizers for poll-style values -@poll1 = λr. - @bind(r, λx.@pure(x)) - -@poll2 = λr. - @bind(r, λx.@pure(x)) - -@await_poll1 = λ&poll. λh0. - ! f0 = λ st ; - @do_ok( - [ - f0, @poll1(poll(h0)) - ], - λ{ - #Pend: λh1.@await_poll1(poll, h1); - #Rdy: λh1.@pure(h1); - &{} - }(st) - ) - -@await_poll2 = λ&poll. λh0. - ! f0 = λ st ; - @do_ok( - [ - f0, @poll2(poll(h0)) - ], - λ{ - #Pend: λh1.@await_poll2(poll, h1); - #Rdy: λh1. λe1.@pure(#Pack{h1,e1}); - &{} - }(st) - ) - -// ----------------------------------------------------------------------------- -// Timer -// ----------------------------------------------------------------------------- - -@timer_start_ok = λms. - %timer_start(ms) - -@timer_poll_ok = λt. - %timer_poll(t) - -@timer_wait_ok = λt. - @wait1(%timer_wait(t)) - -@sleep_ms = λms. - ! f0 = λ t0 ; - ! f1 = λ t1 ; - @do_ok( - [ - f0, @timer_start_ok(ms), - f1, @timer_wait_ok(t0) - ], - [] - ) - -@sleep_s = λsec. - @sleep_ms(sec * 1000) - -// ----------------------------------------------------------------------------- -// Process -// ----------------------------------------------------------------------------- - -@process_spawn_ok = λcmd. - %process_spawn(cmd) - -@process_poll_ok = λproc. - %process_poll(proc) - -@process_wait_ok = λproc. - @wait2(%process_wait(proc)) - -@process_wait_evt = λproc. - ! f0 = λ w0 ; - @do_ok( - [ - f0, @process_wait_ok(proc) - ], - @snd(w0) - ) - -@process_kill_ok = λproc. - %process_kill(proc) - -@process_run = λcmd. - ! f0 = λ p0 ; - ! f1 = λ e1 ; - @do_ok( - [ - f0, @process_spawn_ok(cmd), - f1, @process_wait_evt(p0) - ], - e1 - ) - -// ----------------------------------------------------------------------------- -// Stream -// ----------------------------------------------------------------------------- - -@stream_stdin_open_ok = λseed. - %stream_stdin_open(seed) - -@stream_file_open_ok = λpath. - %stream_file_open(path) - -@stream_poll_ok = λstrm. - %stream_poll(strm) - -@stream_wait_ok = λstrm. - @wait2(%stream_wait(strm)) - -@stream_close_ok = λstrm. - %stream_close(strm) - -@list_rev = λxs. - @list_rev_go(xs, []) - -@list_rev_go = λxs. λ&acc. - λ{ - []: acc; - <>: λh. λt.@list_rev_go(t, h <> acc); - &{} - }(xs) - -@stream_read_all = λstrm. - @stream_read_all_go(strm, []) - -@stream_read_all_go = λstrm. λ&acc. - ! f0 = λ w ; - @do_ok( - [ - f0, @stream_wait_ok(strm) - ], - !&wr = w; - !&h = @fst(wr); - ! e = @snd(wr); - !&a = acc; - λ{ - #BYT: λn.@stream_read_all_go(h, #BYT{n} <> a); - #Eof: @pure(#Pack{h, @list_rev(a)}); - &{} - }(e) - ) - -@stream_close_and_take = λr1. - !&r = r1; - ! h = @fst(r); - ! b = @snd(r); - ! f0 = λ c0 ; - @do_ok( - [ - f0, @stream_close_ok(h) - ], - b - ) - -@stream_file_read_all = λpath. - ! f0 = λ s0 ; - ! f1 = λ r1 ; - ! f2 = λ b2 ; - @do_ok( - [ - f0, @stream_file_open_ok(path), - f1, @stream_read_all(s0), - f2, @stream_close_and_take(r1) - ], - b2 - ) - -// ----------------------------------------------------------------------------- -// HTTP -// ----------------------------------------------------------------------------- - -@http_opts_default = - #Opts{5000,2000,#F{},0,#T{},65536} - -@http_req = λmethod. λurl. λheaders. λbody. λopts. - #Req{method,url,headers,body,opts} - -@http_get_req = λurl. - #Req{#Get{},url,[],#NoBody{},@http_opts_default} - -@http_post_text_req = λurl. λtext. - #Req{#Post{},url,[],#BodyText{text},@http_opts_default} - -@http_post_bytes_req = λurl. λbbs. - #Req{#Post{},url,[],#BodyBytes{bbs},@http_opts_default} - -@http_request_ok = λreq. - %http_request(req) - -@http_poll_ok = λhttp. - %http_poll(http) - -@http_wait_ok = λhttp. - @wait2(%http_wait(http)) - -@http_cancel_ok = λhttp. - %http_cancel(http) - -@http_request_wait = λreq. - ! f0 = λ h0 ; - ! f1 = λ w1 ; - @do_ok( - [ - f0, @http_request_ok(req), - f1, @http_wait_ok(h0) - ], - @snd(w1) - ) - -@http_get = λurl. - @http_request_wait(@http_get_req(url)) - -@http_post_text = λurl. λtext. - @http_request_wait(@http_post_text_req(url, text)) - -@http_post_bytes = λurl. λbbs. - @http_request_wait(@http_post_bytes_req(url, bbs)) - -// ----------------------------------------------------------------------------- -// TCP -// ----------------------------------------------------------------------------- - -@tcp_opts_default = - #TcpOpts{5000,5000,5000,#T{},#F{}} - -@tcp_req = λhost. λport. λopts. - #TcpReq{host,port,opts} - -@tcp_connect_ok = λreq. - %tcp_connect(req) - -@tcp_connect_poll_ok = λtcp. - %tcp_connect_poll(tcp) - -@tcp_connect_wait_ok = λtcp. - @wait2(%tcp_connect_wait(tcp)) - -@tcp_send_poll_ok = λtcp. λdata. - %tcp_send_poll(tcp, data) - -@tcp_send_wait_ok = λtcp. λdata. - @wait2(%tcp_send_wait(tcp, data)) - -@tcp_recv_poll_ok = λtcp. λmaxb. - %tcp_recv_poll(tcp, maxb) - -@tcp_recv_wait_ok = λtcp. λmaxb. - @wait2(%tcp_recv_wait(tcp, maxb)) - -@tcp_close_ok = λtcp. - @wait2(%tcp_close(tcp)) - -@tcp_expect_conn = λw1. - !&w = w1; - ! h = @fst(w); - λ{ - #Conn: @pure(h); - #Fail: λreason. λmsg.#ERR{msg}; - &{} - }(@snd(w)) - -@tcp_connect_open = λreq. - ! f0 = λ t0 ; - ! f1 = λ w1 ; - ! f2 = λ h2 ; - @do_ok( - [ - f0, @tcp_connect_ok(req), - f1, @tcp_connect_wait_ok(t0), - f2, @tcp_expect_conn(w1) - ], - h2 - ) - -@tcp_step_send = λw1. λdata. - !&p = w1; - ! h1 = @fst(p); - ! cevt = @snd(p); - ! f0 = λ w2 ; - @do_ok( - [ - f0, @tcp_send_wait_ok(h1, data) - ], - #Pack{w2, cevt} - ) - -@tcp_step_recv = λst. λmaxb. - !&s = st; - ! w2 = @fst(s); - ! cevt = @snd(s); - !&q = w2; - ! h2 = @fst(q); - ! sevt = @snd(q); - ! f0 = λ w3 ; - @do_ok( - [ - f0, @tcp_recv_wait_ok(h2, maxb) - ], - #Pack{w3, #Pack{cevt,sevt}} - ) - -@tcp_step_close = λst. - !&s = st; - ! w3 = @fst(s); - ! pair = @snd(s); - !&q = w3; - ! h3 = @fst(q); - ! revt = @snd(q); - !&r = pair; - ! cevt = @fst(r); - ! sevt = @snd(r); - ! f0 = λ w4 ; - @do_ok( - [ - f0, @tcp_close_ok(h3) - ], - #Pack{cevt, #Pack{sevt, revt}} - ) - -@tcp_roundtrip = λreq. λdata. λmaxb. - ! f0 = λ t0 ; - ! f1 = λ w1 ; - ! f2 = λ st2 ; - ! f3 = λ st3 ; - ! f4 = λ out ; - @do_ok( - [ - f0, @tcp_connect_ok(req), - f1, @tcp_connect_wait_ok(t0), - f2, @tcp_step_send(w1, data), - f3, @tcp_step_recv(st2, maxb), - f4, @tcp_step_close(st3) - ], - out - ) - -// ----------------------------------------------------------------------------- -// File + System Convenience -// ----------------------------------------------------------------------------- - -@fs_read_text = λpath. - %read_file(path) - -@fs_read_bytes = λpath. - %read_bytes(path) - -@fs_write_text = λpath. λtext. - %write_file(path, text) - -@fs_write_bytes = λpath. λdata. - %write_bytes(path, data) - -@env_get = λname. - %env(name) - -@cwd_get = - %cwd(0) - -@chdir_ok = λpath. - %chdir(path) - -@argv = - %argv(0) - -@uid = - %uid(0) - -@rand = - %rand(0) - -@uuid_ok = - %uuid(0) - -@argv_ok = - @pure(@argv) - -@uid_ok = - @pure(@uid) - -@rand_ok = - @pure(@rand) - -@abort = λmsg. - %panic(msg) +// Compatibility entrypoint for stdlib modules +#include "stdlib/all.hvm4" From 2108363c958ac8dd223a022d150b20838a52f163 Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Mon, 16 Feb 2026 08:08:48 -0300 Subject: [PATCH 32/35] rm --- stdlib.hvm4 | 2 -- 1 file changed, 2 deletions(-) delete mode 100644 stdlib.hvm4 diff --git a/stdlib.hvm4 b/stdlib.hvm4 deleted file mode 100644 index 253c4dec..00000000 --- a/stdlib.hvm4 +++ /dev/null @@ -1,2 +0,0 @@ -// Compatibility entrypoint for stdlib modules -#include "stdlib/all.hvm4" From a73f1fa95fd288f507951803f84d3532a484166d Mon Sep 17 00:00:00 2001 From: Lorenzobattistela Date: Tue, 17 Feb 2026 07:28:39 -0300 Subject: [PATCH 33/35] prims: use table symbols for async ctor names --- clang/prim/fn/http/_.c | 66 +++++++++++++++++++-------------------- clang/prim/fn/process/_.c | 10 +++--- clang/prim/fn/stream/_.c | 8 ++--- clang/prim/fn/tcp/_.c | 50 ++++++++++++++--------------- clang/prim/fn/timer/_.c | 6 ++-- 5 files changed, 70 insertions(+), 70 deletions(-) diff --git a/clang/prim/fn/http/_.c b/clang/prim/fn/http/_.c index 29120b18..a320a158 100644 --- a/clang/prim/fn/http/_.c +++ b/clang/prim/fn/http/_.c @@ -1471,39 +1471,39 @@ fn u8 http_claim( #include "cancel.c" fn void prim_http_init(void) { - HTTP_NAM_HTTP = nick_from_str("Http", 4); - HTTP_NAM_PEND = nick_from_str("Pend", 4); - HTTP_NAM_RDY = nick_from_str("Rdy", 3); - HTTP_NAM_RESP = nick_from_str("Resp", 4); - HTTP_NAM_HDR = nick_from_str("Hdr", 3); - HTTP_NAM_FAIL = nick_from_str("Fail", 4); - HTTP_NAM_CANCELED = nick_from_str("Canceled", 8); - - HTTP_NAM_TIMEOUT = nick_from_str("Timeout", 7); - HTTP_NAM_DNS = nick_from_str("Dns", 3); - HTTP_NAM_CONNECT = nick_from_str("Connect", 7); - HTTP_NAM_TLS = nick_from_str("Tls", 3); - HTTP_NAM_PROTOCOL = nick_from_str("Protocol", 8); - HTTP_NAM_CURL_EXIT = nick_from_str("CurlExit", 8); - HTTP_NAM_CURL_SIGNAL = nick_from_str("CurlSignal", 10); - HTTP_NAM_PARSE = nick_from_str("Parse", 5); - HTTP_NAM_BODY_TOO_LARGE = nick_from_str("BodyTooLarge", 12); - HTTP_NAM_IO = nick_from_str("Io", 2); - - HTTP_NAM_REQ = nick_from_str("Req", 3); - HTTP_NAM_GET = nick_from_str("Get", 3); - HTTP_NAM_POST = nick_from_str("Post", 4); - HTTP_NAM_PUT = nick_from_str("Put", 3); - HTTP_NAM_PATCH = nick_from_str("Patch", 5); - HTTP_NAM_DELETE = nick_from_str("Delete", 6); - HTTP_NAM_HEAD = nick_from_str("Head", 4); - HTTP_NAM_OPTIONS = nick_from_str("Options", 7); - HTTP_NAM_NOBODY = nick_from_str("NoBody", 6); - HTTP_NAM_BODY_TEXT = nick_from_str("BodyText", 8); - HTTP_NAM_BODY_BYTES = nick_from_str("BodyBytes", 9); - HTTP_NAM_OPTS = nick_from_str("Opts", 4); - HTTP_NAM_T = nick_from_str("T", 1); - HTTP_NAM_F = nick_from_str("F", 1); + HTTP_NAM_HTTP = table_find("Http", 4); + HTTP_NAM_PEND = table_find("Pend", 4); + HTTP_NAM_RDY = table_find("Rdy", 3); + HTTP_NAM_RESP = table_find("Resp", 4); + HTTP_NAM_HDR = table_find("Hdr", 3); + HTTP_NAM_FAIL = table_find("Fail", 4); + HTTP_NAM_CANCELED = table_find("Canceled", 8); + + HTTP_NAM_TIMEOUT = table_find("Timeout", 7); + HTTP_NAM_DNS = table_find("Dns", 3); + HTTP_NAM_CONNECT = table_find("Connect", 7); + HTTP_NAM_TLS = table_find("Tls", 3); + HTTP_NAM_PROTOCOL = table_find("Protocol", 8); + HTTP_NAM_CURL_EXIT = table_find("CurlExit", 8); + HTTP_NAM_CURL_SIGNAL = table_find("CurlSignal", 10); + HTTP_NAM_PARSE = table_find("Parse", 5); + HTTP_NAM_BODY_TOO_LARGE = table_find("BodyTooLarge", 12); + HTTP_NAM_IO = table_find("Io", 2); + + HTTP_NAM_REQ = table_find("Req", 3); + HTTP_NAM_GET = table_find("Get", 3); + HTTP_NAM_POST = table_find("Post", 4); + HTTP_NAM_PUT = table_find("Put", 3); + HTTP_NAM_PATCH = table_find("Patch", 5); + HTTP_NAM_DELETE = table_find("Delete", 6); + HTTP_NAM_HEAD = table_find("Head", 4); + HTTP_NAM_OPTIONS = table_find("Options", 7); + HTTP_NAM_NOBODY = table_find("NoBody", 6); + HTTP_NAM_BODY_TEXT = table_find("BodyText", 8); + HTTP_NAM_BODY_BYTES = table_find("BodyBytes", 9); + HTTP_NAM_OPTS = table_find("Opts", 4); + HTTP_NAM_T = table_find("T", 1); + HTTP_NAM_F = table_find("F", 1); prim_http_request_init(); prim_http_poll_init(); diff --git a/clang/prim/fn/process/_.c b/clang/prim/fn/process/_.c index f6861c2a..0965f5a9 100644 --- a/clang/prim/fn/process/_.c +++ b/clang/prim/fn/process/_.c @@ -186,11 +186,11 @@ fn void process_status_from_wait(int status, u8 *signaled, u32 *code) { #include "kill.c" fn void prim_process_init(void) { - PROCESS_NAM_PROC = nick_from_str("Proc", 4); - PROCESS_NAM_PEND = nick_from_str("Pend", 4); - PROCESS_NAM_RDY = nick_from_str("Rdy", 3); - PROCESS_NAM_EXIT = nick_from_str("Exit", 4); - PROCESS_NAM_SIG = nick_from_str("Sig", 3); + PROCESS_NAM_PROC = table_find("Proc", 4); + PROCESS_NAM_PEND = table_find("Pend", 4); + PROCESS_NAM_RDY = table_find("Rdy", 3); + PROCESS_NAM_EXIT = table_find("Exit", 4); + PROCESS_NAM_SIG = table_find("Sig", 3); prim_process_spawn_init(); prim_process_poll_init(); diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c index 69d7ca44..7d1da68a 100644 --- a/clang/prim/fn/stream/_.c +++ b/clang/prim/fn/stream/_.c @@ -221,10 +221,10 @@ fn int stream_stdin_read(int fd, int timeout_ms, u8 *out_byt, u8 *out_eof) { #include "close.c" fn void prim_stream_init(void) { - STREAM_NAM_STRM = nick_from_str("Strm", 4); - STREAM_NAM_PEND = nick_from_str("Pend", 4); - STREAM_NAM_RDY = nick_from_str("Rdy", 3); - STREAM_NAM_EOF = nick_from_str("Eof", 3); + STREAM_NAM_STRM = table_find("Strm", 4); + STREAM_NAM_PEND = table_find("Pend", 4); + STREAM_NAM_RDY = table_find("Rdy", 3); + STREAM_NAM_EOF = table_find("Eof", 3); prim_stream_stdin_open_init(); prim_stream_file_open_init(); diff --git a/clang/prim/fn/tcp/_.c b/clang/prim/fn/tcp/_.c index 964cb1b3..cc6d5caa 100644 --- a/clang/prim/fn/tcp/_.c +++ b/clang/prim/fn/tcp/_.c @@ -671,31 +671,31 @@ fn Term tcp_state_not_connected(u32 id, u32 seq) { #include "close.c" fn void prim_tcp_init(void) { - TCP_NAM_TCP = nick_from_str("Tcp", 3); - TCP_NAM_TCP_REQ = nick_from_str("TcpReq", 6); - TCP_NAM_TCP_OPTS = nick_from_str("TcpOpts", 7); - - TCP_NAM_PEND = nick_from_str("Pend", 4); - TCP_NAM_RDY = nick_from_str("Rdy", 3); - TCP_NAM_CONN = nick_from_str("Conn", 4); - TCP_NAM_RECV = nick_from_str("Recv", 4); - TCP_NAM_SENT = nick_from_str("Sent", 4); - TCP_NAM_EOF = nick_from_str("Eof", 3); - TCP_NAM_CLOSED = nick_from_str("Closed", 6); - TCP_NAM_FAIL = nick_from_str("Fail", 4); - - TCP_NAM_TIMEOUT = nick_from_str("Timeout", 7); - TCP_NAM_DNS = nick_from_str("Dns", 3); - TCP_NAM_REFUSED = nick_from_str("Refused", 7); - TCP_NAM_UNREACHABLE = nick_from_str("Unreachable", 11); - TCP_NAM_RESET = nick_from_str("Reset", 5); - TCP_NAM_BROKEN_PIPE = nick_from_str("BrokenPipe", 10); - TCP_NAM_PROTOCOL = nick_from_str("Protocol", 8); - TCP_NAM_NOT_CONNECTED = nick_from_str("NotConnected", 12); - TCP_NAM_SYS = nick_from_str("Sys", 3); - - TCP_NAM_T = nick_from_str("T", 1); - TCP_NAM_F = nick_from_str("F", 1); + TCP_NAM_TCP = table_find("Tcp", 3); + TCP_NAM_TCP_REQ = table_find("TcpReq", 6); + TCP_NAM_TCP_OPTS = table_find("TcpOpts", 7); + + TCP_NAM_PEND = table_find("Pend", 4); + TCP_NAM_RDY = table_find("Rdy", 3); + TCP_NAM_CONN = table_find("Conn", 4); + TCP_NAM_RECV = table_find("Recv", 4); + TCP_NAM_SENT = table_find("Sent", 4); + TCP_NAM_EOF = table_find("Eof", 3); + TCP_NAM_CLOSED = table_find("Closed", 6); + TCP_NAM_FAIL = table_find("Fail", 4); + + TCP_NAM_TIMEOUT = table_find("Timeout", 7); + TCP_NAM_DNS = table_find("Dns", 3); + TCP_NAM_REFUSED = table_find("Refused", 7); + TCP_NAM_UNREACHABLE = table_find("Unreachable", 11); + TCP_NAM_RESET = table_find("Reset", 5); + TCP_NAM_BROKEN_PIPE = table_find("BrokenPipe", 10); + TCP_NAM_PROTOCOL = table_find("Protocol", 8); + TCP_NAM_NOT_CONNECTED = table_find("NotConnected", 12); + TCP_NAM_SYS = table_find("Sys", 3); + + TCP_NAM_T = table_find("T", 1); + TCP_NAM_F = table_find("F", 1); prim_tcp_connect_init(); prim_tcp_connect_poll_init(); diff --git a/clang/prim/fn/timer/_.c b/clang/prim/fn/timer/_.c index 3b918f60..5b23d1f2 100644 --- a/clang/prim/fn/timer/_.c +++ b/clang/prim/fn/timer/_.c @@ -141,9 +141,9 @@ fn u8 timer_claim(u32 id, u32 seq, u64 *due_ns) { #include "wait.c" fn void prim_timer_init(void) { - TIMER_NAM_TIME = nick_from_str("Time", 4); - TIMER_NAM_PEND = nick_from_str("Pend", 4); - TIMER_NAM_RDY = nick_from_str("Rdy", 3); + TIMER_NAM_TIME = table_find("Time", 4); + TIMER_NAM_PEND = table_find("Pend", 4); + TIMER_NAM_RDY = table_find("Rdy", 3); prim_timer_start_init(); prim_timer_poll_init(); From 173ce652aacc901891e767502521ab901681108e Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Wed, 25 Feb 2026 20:50:54 +0400 Subject: [PATCH 34/35] prims: switch prim ctor symbols to SYM and add argv echo test --- clang/nick/names.c | 11 ---- clang/prim/fn/argv.c | 4 +- clang/prim/fn/chdir.c | 42 +++++++-------- clang/prim/fn/cwd.c | 4 +- clang/prim/fn/env.c | 40 +++++++------- clang/prim/fn/http/_.c | 28 +++++----- clang/prim/fn/panic.c | 36 ++++++------- clang/prim/fn/process/_.c | 4 +- clang/prim/fn/read_bytes.c | 56 ++++++++++---------- clang/prim/fn/read_file.c | 54 +++++++++---------- clang/prim/fn/stream/_.c | 6 +-- clang/prim/fn/stream/close.c | 2 +- clang/prim/fn/tcp/_.c | 20 +++---- clang/prim/fn/tcp/connect.c | 2 +- clang/prim/fn/timer/_.c | 4 +- clang/prim/fn/uuid.c | 4 +- clang/prim/fn/write_bytes.c | 100 +++++++++++++++++------------------ clang/prim/fn/write_file.c | 100 +++++++++++++++++------------------ clang/prim/string.c | 14 ++--- test/prim_argv_echo.hvm | 4 ++ 20 files changed, 264 insertions(+), 271 deletions(-) create mode 100644 test/prim_argv_echo.hvm diff --git a/clang/nick/names.c b/clang/nick/names.c index 67f375a6..2ac26fa8 100644 --- a/clang/nick/names.c +++ b/clang/nick/names.c @@ -11,17 +11,6 @@ static u32 SYM_BYT = 0; static u32 SYM_OK = 0; static u32 SYM_ERR = 0; -// Backward-compatible aliases used across the runtime. -#define NAM_ZER SYM_ZER -#define NAM_SUC SYM_SUC -#define NAM_NIL SYM_NIL -#define NAM_CON SYM_CON -#define NAM_CHR SYM_CHR -#define NAM_U8 SYM_U8 -#define NAM_BYT SYM_BYT -#define NAM_OK SYM_OK -#define NAM_ERR SYM_ERR - fn void symbols_init(void) { SYM_ZER = table_find("ZER", 3); SYM_SUC = table_find("SUC", 3); diff --git a/clang/prim/fn/argv.c b/clang/prim/fn/argv.c index 86c570c5..0edd7af4 100644 --- a/clang/prim/fn/argv.c +++ b/clang/prim/fn/argv.c @@ -4,7 +4,7 @@ fn Term prim_fn_argv(Term *args) { (void)args[0]; - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term out = nil; Term cur = nil; u8 has_node = 0; @@ -14,7 +14,7 @@ fn Term prim_fn_argv(Term *args) { Term str = term_string_from_utf8(arg); Term h_t[2] = {str, nil}; - Term node = term_new_ctr(NAM_CON, 2, h_t); + Term node = term_new_ctr(SYM_CON, 2, h_t); if (!has_node) { out = node; diff --git a/clang/prim/fn/chdir.c b/clang/prim/fn/chdir.c index 051df750..4ef9c023 100644 --- a/clang/prim/fn/chdir.c +++ b/clang/prim/fn/chdir.c @@ -57,17 +57,17 @@ fn Term chdir_go_path(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %chdir_go_path(acc, #Nil) // ------------------------- chdir-go-path-nil // %chdir_go_io(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term path = term_new_app(acc, nil); Term io_args[1] = {path}; Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); return wnf(io); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %chdir_go_path(acc, #Con{h,t}) // ------------------------------ chdir-go-path-con // %chdir_go_chr(acc, h, t) @@ -116,7 +116,7 @@ fn Term chdir_go_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("chdir", 5), 1, &app); heap_set(inc_loc, next); @@ -134,8 +134,8 @@ fn Term chdir_go_chr(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("chdir", 5), 1, &app0); @@ -143,7 +143,7 @@ fn Term chdir_go_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %chdir_go_chr(acc, #Chr{c}, t) // ------------------------------ chdir-go-chr-chr // %chdir_go_num(acc, c, t) @@ -162,7 +162,7 @@ fn Term chdir_go_chr(Term *args) { // ------------------------- chdir-go-chr-default // %chdir_go_io(acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); Term io_args[1] = {path}; Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); @@ -192,9 +192,9 @@ fn Term chdir_go_num(Term *args) { // ↑(%chdir(acc(#Con{#Chr{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("chdir", 5), 1, &app); heap_set(inc_loc, next); @@ -210,12 +210,12 @@ fn Term chdir_go_num(Term *args) { Term y = heap_read(sup_loc + 1); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("chdir", 5), 1, &app0); @@ -228,9 +228,9 @@ fn Term chdir_go_num(Term *args) { // %chdir_go_path(λx.acc(#Con{#Chr{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[2] = {acc_next, tail}; @@ -241,9 +241,9 @@ fn Term chdir_go_num(Term *args) { // %chdir_go_num(acc, c, t) // ------------------------ chdir-go-num-default // %chdir_go_io(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); Term io_args[1] = {path}; Term io = term_new_pri(table_find("chdir_go_io", 11), 1, io_args); @@ -268,11 +268,11 @@ fn Term prim_fn_chdir_go_io(Term *args) { if (chdir(path) != 0) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(CHDIR_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(CHDIR_ERR_FMT, path, strerror(err), err) }); } - Term Nil = term_new_ctr(NAM_NIL, 0, 0); - return term_new_ctr(NAM_OK, 1, &Nil); + Term Nil = term_new_ctr(SYM_NIL, 0, 0); + return term_new_ctr(SYM_OK, 1, &Nil); } fn void prim_chdir_init(void) { diff --git a/clang/prim/fn/cwd.c b/clang/prim/fn/cwd.c index da639efa..3e265306 100644 --- a/clang/prim/fn/cwd.c +++ b/clang/prim/fn/cwd.c @@ -12,11 +12,11 @@ fn Term prim_fn_cwd(Term *args) { if (getcwd(cwd, MAX_CWD) == NULL) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(GETCWD_ERR_FMT, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(GETCWD_ERR_FMT, strerror(err), err) }); } Term out = term_string_from_utf8(cwd); - return term_new_ctr(NAM_OK, 1, &out); + return term_new_ctr(SYM_OK, 1, &out); } fn void prim_cwd_init(void) { diff --git a/clang/prim/fn/env.c b/clang/prim/fn/env.c index 000821f0..99fcfd45 100644 --- a/clang/prim/fn/env.c +++ b/clang/prim/fn/env.c @@ -55,17 +55,17 @@ fn Term env_go_name(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %env_go_name(acc, #Nil) // ----------------------- env-go-name-nil // %env_go_io(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term name = term_new_app(acc, nil); Term io_args[1] = {name}; Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); return wnf(io); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %env_go_name(acc, #Con{h,t}) // ---------------------------- env-go-name-con // %env_go_chr(acc, h, t) @@ -114,7 +114,7 @@ fn Term env_go_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("env", 3), 1, &app); heap_set(inc_loc, next); @@ -132,8 +132,8 @@ fn Term env_go_chr(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("env", 3), 1, &app0); @@ -141,7 +141,7 @@ fn Term env_go_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %env_go_chr(acc, #Chr{c}, t) // ---------------------------- env-go-chr-chr // %env_go_num(acc, c, t) @@ -160,7 +160,7 @@ fn Term env_go_chr(Term *args) { // ----------------------- env-go-chr-default // %env_go_io(acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term name = term_new_app(acc, con); Term io_args[1] = {name}; Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); @@ -190,9 +190,9 @@ fn Term env_go_num(Term *args) { // ↑(%env(acc(#Con{#Chr{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("env", 3), 1, &app); heap_set(inc_loc, next); @@ -208,12 +208,12 @@ fn Term env_go_num(Term *args) { Term y = heap_read(sup_loc + 1); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("env", 3), 1, &app0); @@ -226,9 +226,9 @@ fn Term env_go_num(Term *args) { // %env_go_name(λx.acc(#Con{#Chr{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[2] = {acc_next, tail}; @@ -239,9 +239,9 @@ fn Term env_go_num(Term *args) { // %env_go_num(acc, c, t) // ----------------------- env-go-num-default // %env_go_io(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term name = term_new_app(acc, con); Term io_args[1] = {name}; Term io = term_new_pri(table_find("env_go_io", 9), 1, io_args); @@ -266,11 +266,11 @@ fn Term prim_fn_env_go_io(Term *args) { const char *value = getenv(name); if (value == NULL) { - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(NOT_FOUND_FMT, name) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(NOT_FOUND_FMT, name) }); } Term out = term_string_from_utf8(value); - return term_new_ctr(NAM_OK, 1, &out); + return term_new_ctr(SYM_OK, 1, &out); } fn void prim_env_init(void) { diff --git a/clang/prim/fn/http/_.c b/clang/prim/fn/http/_.c index a320a158..cca6afdf 100644 --- a/clang/prim/fn/http/_.c +++ b/clang/prim/fn/http/_.c @@ -109,11 +109,11 @@ fn Term wnf(Term term); fn Term http_new_err(const char *prim, u32 code, const char *msg) { Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); - return term_new_ctr(NAM_ERR, 1, &txt); + return term_new_ctr(SYM_ERR, 1, &txt); } fn Term http_new_ok(Term val) { - return term_new_ctr(NAM_OK, 1, &val); + return term_new_ctr(SYM_OK, 1, &val); } fn Term http_new_http(u32 id, u32 seq) { @@ -627,7 +627,7 @@ fn u8 http_parse_header_item(Term term, HttpReq *req, Term *err_out) { fn u8 http_parse_headers(Term term, HttpReq *req, Term *err_out) { Term cur = wnf(term); - while (term_tag(cur) == C02 && term_ext(cur) == NAM_CON) { + while (term_tag(cur) == C02 && term_ext(cur) == SYM_CON) { u32 loc = term_val(cur); Term head = heap_read(loc + 0); Term tail = heap_read(loc + 1); @@ -639,7 +639,7 @@ fn u8 http_parse_headers(Term term, HttpReq *req, Term *err_out) { cur = wnf(tail); } - if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + if (term_tag(cur) != C00 || term_ext(cur) != SYM_NIL) { *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `headers`; expected List<#Hdr{name,value}>"); return 0; } @@ -650,12 +650,12 @@ fn u8 http_parse_headers(Term term, HttpReq *req, Term *err_out) { fn u8 http_parse_body_bytes_list(Term term, HttpReq *req, Term *err_out) { Term cur = wnf(term); - while (term_tag(cur) == C02 && term_ext(cur) == NAM_CON) { + while (term_tag(cur) == C02 && term_ext(cur) == SYM_CON) { u32 loc = term_val(cur); Term head = wnf(heap_read(loc + 0)); Term tail = heap_read(loc + 1); - if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { + if (term_tag(head) != C01 || term_ext(head) != SYM_BYT) { *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#BYT{n}>"); return 0; } @@ -680,7 +680,7 @@ fn u8 http_parse_body_bytes_list(Term term, HttpReq *req, Term *err_out) { cur = wnf(tail); } - if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + if (term_tag(cur) != C00 || term_ext(cur) != SYM_NIL) { *err_out = http_new_err("http_request", HTTP_ERR_BAD_ARG, "invalid `body`; expected List<#BYT{n}>"); return 0; } @@ -1216,14 +1216,14 @@ fn int http_read_header_pairs(const char *hdr_path, HttpHdrPair **pairs_out, u32 } fn Term http_pairs_to_term(HttpHdrPair *pairs, u32 len) { - Term out = term_new_ctr(NAM_NIL, 0, NULL); + Term out = term_new_ctr(SYM_NIL, 0, NULL); for (u32 i = len; i > 0; --i) { Term name = term_string_from_utf8(pairs[i - 1].name); Term val = term_string_from_utf8(pairs[i - 1].value); Term hdr = http_new_hdr(name, val); Term args[2] = {hdr, out}; - out = term_new_ctr(NAM_CON, 2, args); + out = term_new_ctr(SYM_CON, 2, args); } return out; @@ -1236,7 +1236,7 @@ fn int http_read_body_bytes(const char *body_path, u32 cap, Term *body_out, int return -1; } - Term nil = term_new_ctr(NAM_NIL, 0, NULL); + Term nil = term_new_ctr(SYM_NIL, 0, NULL); u8 byte = 0; int first = fgetc(f); if (first == EOF) { @@ -1255,8 +1255,8 @@ fn int http_read_body_bytes(const char *body_path, u32 cap, Term *body_out, int u32 count = 1; Term byt_num[1] = {term_new_num(byte)}; - Term node[2] = {term_new_ctr(NAM_BYT, 1, byt_num), nil}; - Term out = term_new_ctr(NAM_CON, 2, node); + Term node[2] = {term_new_ctr(SYM_BYT, 1, byt_num), nil}; + Term out = term_new_ctr(SYM_CON, 2, node); Term curr = out; while (1) { @@ -1272,8 +1272,8 @@ fn int http_read_body_bytes(const char *body_path, u32 cap, Term *body_out, int } byt_num[0] = term_new_num((u8)got); - node[0] = term_new_ctr(NAM_BYT, 1, byt_num); - heap_set(term_val(curr) + 1, term_new_ctr(NAM_CON, 2, node)); + node[0] = term_new_ctr(SYM_BYT, 1, byt_num); + heap_set(term_val(curr) + 1, term_new_ctr(SYM_CON, 2, node)); curr = heap_read(term_val(curr) + 1); } diff --git a/clang/prim/fn/panic.c b/clang/prim/fn/panic.c index 61918215..f613a8d9 100644 --- a/clang/prim/fn/panic.c +++ b/clang/prim/fn/panic.c @@ -65,17 +65,17 @@ fn Term panic_go_msg(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %panic_go_msg(acc, #Nil) // ------------------------ panic-go-msg-nil // %panic_go_abort(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term str = term_new_app(acc, nil); Term args0[1] = {str}; Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); return wnf(t); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %panic_go_msg(acc, #Con{h,t}) // ----------------------------- panic-go-msg-con // %panic_go_chr(acc, h, t) @@ -124,7 +124,7 @@ fn Term panic_go_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("panic", 5), 1, &app); heap_set(inc_loc, next); @@ -142,8 +142,8 @@ fn Term panic_go_chr(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("panic", 5), 1, &app0); @@ -151,7 +151,7 @@ fn Term panic_go_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %panic_go_chr(acc, #Chr{c}, t) // ------------------------------ panic-go-chr-chr // %panic_go_num(acc, c, t) @@ -170,7 +170,7 @@ fn Term panic_go_chr(Term *args) { // ------------------------- panic-go-chr-default // %panic_go_abort(acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term str = term_new_app(acc, con); Term args0[1] = {str}; Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); @@ -200,9 +200,9 @@ fn Term panic_go_num(Term *args) { // ↑(%panic(acc(#Con{#Chr{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("panic", 5), 1, &app); heap_set(inc_loc, next); @@ -218,12 +218,12 @@ fn Term panic_go_num(Term *args) { Term y = heap_read(sup_loc + 1); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("panic", 5), 1, &app0); @@ -236,9 +236,9 @@ fn Term panic_go_num(Term *args) { // %panic_go_msg(λx.acc(#Con{#Chr{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[2] = {acc_next, tail}; @@ -249,9 +249,9 @@ fn Term panic_go_num(Term *args) { // %panic_go_num(acc, c, t) // ------------------------- panic-go-num-default // %panic_go_abort(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term str = term_new_app(acc, con); Term args0[1] = {str}; Term t = term_new_pri(table_find("panic_go_abort", 14), 1, args0); diff --git a/clang/prim/fn/process/_.c b/clang/prim/fn/process/_.c index 0965f5a9..26f3631b 100644 --- a/clang/prim/fn/process/_.c +++ b/clang/prim/fn/process/_.c @@ -32,11 +32,11 @@ fn Term wnf(Term term); fn Term process_new_err(const char *prim, u32 code, const char *msg) { Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); - return term_new_ctr(NAM_ERR, 1, &txt); + return term_new_ctr(SYM_ERR, 1, &txt); } fn Term process_new_ok(Term val) { - return term_new_ctr(NAM_OK, 1, &val); + return term_new_ctr(SYM_OK, 1, &val); } fn Term process_new_proc(u32 id, u32 seq) { diff --git a/clang/prim/fn/read_bytes.c b/clang/prim/fn/read_bytes.c index d8c02879..93d33d2b 100644 --- a/clang/prim/fn/read_bytes.c +++ b/clang/prim/fn/read_bytes.c @@ -55,17 +55,17 @@ fn Term read_bytes_go_path(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %read_bytes_go_path(acc, #Nil) // ------------------------------ read-bytes-go-path-nil // %read_bytes_go_io(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term path = term_new_app(acc, nil); Term io_args[1] = {path}; Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); return wnf(io); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %read_bytes_go_path(acc, #Con{h,t}) // ----------------------------------- read-bytes-go-path-con // %read_bytes_go_chr(acc, h, t) @@ -114,7 +114,7 @@ fn Term read_bytes_go_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("read_bytes", 10), 1, &app); heap_set(inc_loc, next); @@ -132,8 +132,8 @@ fn Term read_bytes_go_chr(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("read_bytes", 10), 1, &app0); @@ -141,7 +141,7 @@ fn Term read_bytes_go_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %read_bytes_go_chr(acc, #Chr{c}, t) // ------------------------------------ read-bytes-go-chr-chr // %read_bytes_go_num(acc, c, t) @@ -160,7 +160,7 @@ fn Term read_bytes_go_chr(Term *args) { // ------------------------------ read-bytes-go-chr-default // %read_bytes_go_io(acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); Term io_args[1] = {path}; Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); @@ -190,9 +190,9 @@ fn Term read_bytes_go_num(Term *args) { // ↑(%read_bytes(acc(#Con{#Chr{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("read_bytes", 10), 1, &app); heap_set(inc_loc, next); @@ -208,12 +208,12 @@ fn Term read_bytes_go_num(Term *args) { Term y = heap_read(sup_loc + 1); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("read_bytes", 10), 1, &app0); @@ -226,9 +226,9 @@ fn Term read_bytes_go_num(Term *args) { // %read_bytes_go_path(λx.acc(#Con{#Chr{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[2] = {acc_next, tail}; @@ -239,9 +239,9 @@ fn Term read_bytes_go_num(Term *args) { // %read_bytes_go_num(acc, c, t) // ------------------------------ read-bytes-go-num-default // %read_bytes_go_io(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); Term io_args[1] = {path}; Term io = term_new_pri(table_find("read_bytes_go_io", 16), 1, io_args); @@ -268,11 +268,11 @@ fn Term prim_fn_read_bytes_go_io(Term *args) { FILE *file = fopen(path, "rb"); if (!file) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); } // Initialize output list (empty file => #OK{#NIL}). - Term Nil = term_new_ctr(NAM_NIL, 0, 0); + Term Nil = term_new_ctr(SYM_NIL, 0, 0); unsigned char c; // First read distinguishes empty file (EOF) from read error. if (fread(&c, 1, 1, file) != 1) { @@ -280,24 +280,24 @@ fn Term prim_fn_read_bytes_go_io(Term *args) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); } // First read hit EOF: file is empty, so payload is #NIL. fclose(file); - return term_new_ctr(NAM_OK, 1, &Nil); + return term_new_ctr(SYM_OK, 1, &Nil); } Term byt[1] = {term_new_num(c)}; - Term h_t[2] = {term_new_ctr(NAM_BYT, 1, byt), Nil}; - Term result = term_new_ctr(NAM_CON, 2, h_t); + Term h_t[2] = {term_new_ctr(SYM_BYT, 1, byt), Nil}; + Term result = term_new_ctr(SYM_CON, 2, h_t); // `curr` is the last #CON in the output List<#BYT{NUM}>. Term curr = result; while (fread(&c, 1, 1, file) == 1) { byt[0] = term_new_num(c); - h_t[0] = term_new_ctr(NAM_BYT, 1, byt); + h_t[0] = term_new_ctr(SYM_BYT, 1, byt); // Append #CON{#BYT{NUM}, #NIL} at curr tail. - heap_set(term_val(curr) + 1, term_new_ctr(NAM_CON, 2, h_t)); + heap_set(term_val(curr) + 1, term_new_ctr(SYM_CON, 2, h_t)); curr = heap_read(term_val(curr) + 1); } @@ -305,11 +305,11 @@ fn Term prim_fn_read_bytes_go_io(Term *args) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); } fclose(file); - return term_new_ctr(NAM_OK, 1, &result); + return term_new_ctr(SYM_OK, 1, &result); } fn void prim_read_bytes_init(void) { diff --git a/clang/prim/fn/read_file.c b/clang/prim/fn/read_file.c index 1c8f8458..d90e38f3 100644 --- a/clang/prim/fn/read_file.c +++ b/clang/prim/fn/read_file.c @@ -55,17 +55,17 @@ fn Term read_file_go_path(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %read_file_go_path(acc, #Nil) // ---------------------------- read-file-go-path-nil // %read_file_go_io(acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term path = term_new_app(acc, nil); Term io_args[1] = {path}; Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); return wnf(io); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %read_file_go_path(acc, #Con{h,t}) // --------------------------------- read-file-go-path-con // %read_file_go_chr(acc, h, t) @@ -114,7 +114,7 @@ fn Term read_file_go_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("read_file", 9), 1, &app); heap_set(inc_loc, next); @@ -132,8 +132,8 @@ fn Term read_file_go_chr(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); @@ -141,7 +141,7 @@ fn Term read_file_go_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %read_file_go_chr(acc, #Chr{c}, t) // ---------------------------------- read-file-go-chr-chr // %read_file_go_num(acc, c, t) @@ -160,7 +160,7 @@ fn Term read_file_go_chr(Term *args) { // ---------------------------- read-file-go-chr-default // %read_file_go_io(acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); Term io_args[1] = {path}; Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); @@ -190,9 +190,9 @@ fn Term read_file_go_num(Term *args) { // ↑(%read_file(acc(#Con{#Chr{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next = term_new_pri(table_find("read_file", 9), 1, &app); heap_set(inc_loc, next); @@ -208,12 +208,12 @@ fn Term read_file_go_num(Term *args) { Term y = heap_read(sup_loc + 1); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term t0 = term_new_pri(table_find("read_file", 9), 1, &app0); @@ -226,9 +226,9 @@ fn Term read_file_go_num(Term *args) { // %read_file_go_path(λx.acc(#Con{#Chr{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[2] = {acc_next, tail}; @@ -239,9 +239,9 @@ fn Term read_file_go_num(Term *args) { // %read_file_go_num(acc, c, t) // ---------------------------- read-file-go-num-default // %read_file_go_io(acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); Term io_args[1] = {path}; Term io = term_new_pri(table_find("read_file_go_io", 15), 1, io_args); @@ -270,10 +270,10 @@ fn Term prim_fn_read_file_go_io(Term *args) { FILE *file = fopen(path, "rb"); if (!file) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); } - Term Nil = term_new_ctr(NAM_NIL, 0, 0); + Term Nil = term_new_ctr(SYM_NIL, 0, 0); Term result = Nil; Term curr = Nil; u8 has_node = 0; @@ -289,7 +289,7 @@ fn Term prim_fn_read_file_go_io(Term *args) { if (seq_len >= 4) { int seq_start = byte_i - seq_len; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); } seq[seq_len] = b; seq_len += 1; @@ -306,13 +306,13 @@ fn Term prim_fn_read_file_go_io(Term *args) { if (dec < 0) { int seq_start = byte_i - (seq_len - 1); fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(INVALID_UTF8_FMT, seq_start) }); } Term num = term_new_num(cp); - Term chr = term_new_ctr(NAM_CHR, 1, &num); + Term chr = term_new_ctr(SYM_CHR, 1, &num); Term h_t[2] = {chr, Nil}; - Term node = term_new_ctr(NAM_CON, 2, h_t); + Term node = term_new_ctr(SYM_CON, 2, h_t); if (!has_node) { result = node; @@ -330,17 +330,17 @@ fn Term prim_fn_read_file_go_io(Term *args) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(READ_IO_ERR_FMT, path, strerror(err), err) }); } if (seq_len != 0) { int seq_start = byte_i - seq_len; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(TRUNC_UTF8_FMT, seq_start) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(TRUNC_UTF8_FMT, seq_start) }); } fclose(file); - return term_new_ctr(NAM_OK, 1, &result); + return term_new_ctr(SYM_OK, 1, &result); } fn void prim_read_file_init(void) { diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c index 7d1da68a..e6a80b4f 100644 --- a/clang/prim/fn/stream/_.c +++ b/clang/prim/fn/stream/_.c @@ -33,11 +33,11 @@ fn Term wnf(Term term); fn Term stream_new_err(const char *prim, u32 code, const char *msg) { Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); - return term_new_ctr(NAM_ERR, 1, &txt); + return term_new_ctr(SYM_ERR, 1, &txt); } fn Term stream_new_ok(Term val) { - return term_new_ctr(NAM_OK, 1, &val); + return term_new_ctr(SYM_OK, 1, &val); } fn Term stream_new_handle(u32 id, u32 seq) { @@ -52,7 +52,7 @@ fn Term stream_new_pend(u32 id, u32 seq) { fn Term stream_new_byt(u32 byt) { Term arg = term_new_num(byt); - return term_new_ctr(NAM_BYT, 1, &arg); + return term_new_ctr(SYM_BYT, 1, &arg); } fn Term stream_new_eof(void) { diff --git a/clang/prim/fn/stream/close.c b/clang/prim/fn/stream/close.c index 2de45aca..9edb5451 100644 --- a/clang/prim/fn/stream/close.c +++ b/clang/prim/fn/stream/close.c @@ -89,7 +89,7 @@ fn Term prim_fn_stream_close_go_io(Term *args) { } stream_set_closed(id); - Term nil = term_new_ctr(NAM_NIL, 0, NULL); + Term nil = term_new_ctr(SYM_NIL, 0, NULL); return stream_new_ok(nil); } diff --git a/clang/prim/fn/tcp/_.c b/clang/prim/fn/tcp/_.c index cc6d5caa..9c2efa0a 100644 --- a/clang/prim/fn/tcp/_.c +++ b/clang/prim/fn/tcp/_.c @@ -91,11 +91,11 @@ fn Term wnf(Term term); fn Term tcp_new_err(const char *prim, u32 code, const char *msg) { Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); - return term_new_ctr(NAM_ERR, 1, &txt); + return term_new_ctr(SYM_ERR, 1, &txt); } fn Term tcp_new_ok(Term val) { - return term_new_ctr(NAM_OK, 1, &val); + return term_new_ctr(SYM_OK, 1, &val); } fn Term tcp_new_tcp(u32 id, u32 seq) { @@ -535,12 +535,12 @@ fn u8 tcp_decode_bytes( u32 len = 0; u32 cap = 0; - while (term_tag(cur) == C02 && term_ext(cur) == NAM_CON) { + while (term_tag(cur) == C02 && term_ext(cur) == SYM_CON) { u32 loc = term_val(cur); Term head = wnf(heap_read(loc + 0)); Term tail = heap_read(loc + 1); - if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { + if (term_tag(head) != C01 || term_ext(head) != SYM_BYT) { free(buf); *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#BYT{n}>"); return 0; @@ -593,7 +593,7 @@ fn u8 tcp_decode_bytes( cur = wnf(tail); } - if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + if (term_tag(cur) != C00 || term_ext(cur) != SYM_NIL) { free(buf); *err_out = tcp_new_err("tcp_send", TCP_ERR_BAD_ARG, "invalid `bytes`; expected List<#BYT{n}>"); return 0; @@ -605,20 +605,20 @@ fn u8 tcp_decode_bytes( } fn Term tcp_bytes_to_list(const u8 *buf, u32 len) { - Term nil = term_new_ctr(NAM_NIL, 0, NULL); + Term nil = term_new_ctr(SYM_NIL, 0, NULL); if (len == 0) { return nil; } Term byt[1] = {term_new_num(buf[0])}; - Term head_tail[2] = {term_new_ctr(NAM_BYT, 1, byt), nil}; - Term out = term_new_ctr(NAM_CON, 2, head_tail); + Term head_tail[2] = {term_new_ctr(SYM_BYT, 1, byt), nil}; + Term out = term_new_ctr(SYM_CON, 2, head_tail); Term cur = out; for (u32 i = 1; i < len; ++i) { byt[0] = term_new_num(buf[i]); - head_tail[0] = term_new_ctr(NAM_BYT, 1, byt); - heap_set(term_val(cur) + 1, term_new_ctr(NAM_CON, 2, head_tail)); + head_tail[0] = term_new_ctr(SYM_BYT, 1, byt); + heap_set(term_val(cur) + 1, term_new_ctr(SYM_CON, 2, head_tail)); cur = heap_read(term_val(cur) + 1); } diff --git a/clang/prim/fn/tcp/connect.c b/clang/prim/fn/tcp/connect.c index 99a39a81..d260f575 100644 --- a/clang/prim/fn/tcp/connect.c +++ b/clang/prim/fn/tcp/connect.c @@ -98,7 +98,7 @@ fn Term prim_fn_tcp_connect_go_io(Term *args) { Term evt = tcp_fail_from_gai_evt("tcp_connect", gai_err); u32 loc = term_val(evt); Term msg = heap_read(loc + 1); - return term_new_ctr(NAM_ERR, 1, &msg); + return term_new_ctr(SYM_ERR, 1, &msg); } int fd = -1; diff --git a/clang/prim/fn/timer/_.c b/clang/prim/fn/timer/_.c index 5b23d1f2..6c80bdb4 100644 --- a/clang/prim/fn/timer/_.c +++ b/clang/prim/fn/timer/_.c @@ -41,11 +41,11 @@ fn void timer_sleep_ns(u64 ns) { fn Term timer_new_err(const char *prim, u32 code, const char *msg) { Term txt = term_string_printf("ERROR(%s): E%u %s", prim, code, msg); - return term_new_ctr(NAM_ERR, 1, &txt); + return term_new_ctr(SYM_ERR, 1, &txt); } fn Term timer_new_ok(Term val) { - return term_new_ctr(NAM_OK, 1, &val); + return term_new_ctr(SYM_OK, 1, &val); } fn Term timer_new_time(u32 id, u32 seq) { diff --git a/clang/prim/fn/uuid.c b/clang/prim/fn/uuid.c index 9090360e..93f61eff 100644 --- a/clang/prim/fn/uuid.c +++ b/clang/prim/fn/uuid.c @@ -72,7 +72,7 @@ fn Term prim_fn_uuid(Term *args) { u8 bytes[16]; int err = 0; if (!uuid_fill_random(bytes, &err)) { - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(RNG_ERR_FMT, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(RNG_ERR_FMT, strerror(err), err) }); } // RFC4122 variant + version 4 layout bits. @@ -82,7 +82,7 @@ fn Term prim_fn_uuid(Term *args) { char str[37]; uuid_v4_format(bytes, str); Term out = term_string_from_utf8(str); - return term_new_ctr(NAM_OK, 1, &out); + return term_new_ctr(SYM_OK, 1, &out); } fn void prim_uuid_init(void) { diff --git a/clang/prim/fn/write_bytes.c b/clang/prim/fn/write_bytes.c index a1f5d99a..dde45ad2 100644 --- a/clang/prim/fn/write_bytes.c +++ b/clang/prim/fn/write_bytes.c @@ -63,11 +63,11 @@ fn Term write_bytes_go_path(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %write_bytes_go_path(acc, #Nil, data) // -------------------------------------- write-bytes-go-path-nil // %write_bytes_go_data(acc(#Nil), λx.x, data) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term path = term_new_app(acc, nil); u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -76,7 +76,7 @@ fn Term write_bytes_go_path(Term *args) { Term t = term_new_pri(table_find("write_bytes_go_data", 19), 3, args0); return wnf(t); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %write_bytes_go_path(acc, #Con{h,t}, data) // ------------------------------------------- write-bytes-go-path-con // %write_bytes_go_chr(acc, h, t, data) @@ -129,7 +129,7 @@ fn Term write_bytes_go_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next_args[2] = {app, data}; Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); @@ -149,8 +149,8 @@ fn Term write_bytes_go_chr(Term *args) { Copy D = term_clone(lab, data); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term args0[2] = {app0, D.k0}; @@ -160,7 +160,7 @@ fn Term write_bytes_go_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %write_bytes_go_chr(acc, #Chr{c}, t, data) // ------------------------------------------- write-bytes-go-chr-chr // %write_bytes_go_num(acc, c, t, data) @@ -179,7 +179,7 @@ fn Term write_bytes_go_chr(Term *args) { // ------------------------------------- write-bytes-go-chr-default // %write_bytes_go_data(acc(#Con{h, t}), λx.x, data) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -213,9 +213,9 @@ fn Term write_bytes_go_num(Term *args) { // ↑(%write_bytes(acc(#Con{#Chr{x}, t}), data)) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next_args[2] = {app, data}; Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); @@ -233,12 +233,12 @@ fn Term write_bytes_go_num(Term *args) { Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); Copy D = term_clone(lab, data); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term args0[2] = {app0, D.k0}; @@ -253,9 +253,9 @@ fn Term write_bytes_go_num(Term *args) { // %write_bytes_go_path(λx.acc(#Con{#Chr{n}, x}), t, data) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[3] = {acc_next, tail, data}; @@ -266,9 +266,9 @@ fn Term write_bytes_go_num(Term *args) { // %write_bytes_go_num(acc, c, t, data) // ------------------------------------- write-bytes-go-num-default // %write_bytes_go_data(acc(#Con{#Chr{c}, t}), λx.x, data) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -326,17 +326,17 @@ fn Term write_bytes_go_data(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %write_bytes_go_data(path, acc, #Nil) // ------------------------------------- write-bytes-go-data-nil // %write_bytes_go_io(path, acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term data = term_new_app(acc, nil); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); return wnf(io); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %write_bytes_go_data(path, acc, #Con{h,t}) // ------------------------------------------ write-bytes-go-data-con // %write_bytes_go_data_byt(path, acc, h, t) @@ -386,7 +386,7 @@ fn Term write_bytes_go_data_byt(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term next_args[2] = {path, data}; Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); @@ -406,8 +406,8 @@ fn Term write_bytes_go_data_byt(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term data0 = term_new_app(A.k0, con0); Term data1 = term_new_app(A.k1, con1); Term args0[2] = {P.k0, data0}; @@ -417,7 +417,7 @@ fn Term write_bytes_go_data_byt(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_BYT) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_BYT) { // %write_bytes_go_data_byt(path, acc, #BYT{c}, t) // ------------------------------------------------ write-bytes-go-data-byt-byt // %write_bytes_go_data_num(path, acc, c, t) @@ -436,7 +436,7 @@ fn Term write_bytes_go_data_byt(Term *args) { // ------------------------------------------ write-bytes-go-data-byt-default // %write_bytes_go_io(path, acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); @@ -467,9 +467,9 @@ fn Term write_bytes_go_data_num(Term *args) { // ↑(%write_bytes(path, acc(#Con{#BYT{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term byt = term_new_ctr(NAM_BYT, 1, &inner); + Term byt = term_new_ctr(SYM_BYT, 1, &inner); Term con_args[2] = {byt, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term next_args[2] = {path, data}; Term next = term_new_pri(table_find("write_bytes", 11), 2, next_args); @@ -487,12 +487,12 @@ fn Term write_bytes_go_data_num(Term *args) { Copy P = term_clone(lab, path); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term byt0 = term_new_ctr(NAM_BYT, 1, &x); - Term byt1 = term_new_ctr(NAM_BYT, 1, &y); + Term byt0 = term_new_ctr(SYM_BYT, 1, &x); + Term byt1 = term_new_ctr(SYM_BYT, 1, &y); Term con0_args[2] = {byt0, T.k0}; Term con1_args[2] = {byt1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term data0 = term_new_app(A.k0, con0); Term data1 = term_new_app(A.k1, con1); Term args0[2] = {P.k0, data0}; @@ -507,9 +507,9 @@ fn Term write_bytes_go_data_num(Term *args) { // %write_bytes_go_data(path, λx.acc(#Con{#BYT{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term byt = term_new_ctr(NAM_BYT, 1, &code_wnf); + Term byt = term_new_ctr(SYM_BYT, 1, &code_wnf); Term con_args[2] = {byt, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[3] = {path, acc_next, tail}; @@ -520,9 +520,9 @@ fn Term write_bytes_go_data_num(Term *args) { // %write_bytes_go_data_num(path, acc, c, t) // ------------------------------------------ write-bytes-go-data-num-default // %write_bytes_go_io(path, acc(#Con{#BYT{c}, t})) - Term byt = term_new_ctr(NAM_BYT, 1, &code_wnf); + Term byt = term_new_ctr(SYM_BYT, 1, &code_wnf); Term con_args[2] = {byt, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_bytes_go_io", 17), 2, io_args); @@ -555,16 +555,16 @@ fn Term prim_fn_write_bytes_go_io(Term *args) { FILE *file = fopen(path, "wb"); if (!file) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); } // Write hvm4 bytes list List<#BYT{NUM}> into file. data_item = wnf(data_item); while (term_tag(data_item) == C02) { // wnf(data_item) must be List<#BYT{b}> - if (term_ext(data_item) != NAM_CON) { + if (term_ext(data_item) != SYM_CON) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } Term head_loc = term_val(data_item); @@ -573,9 +573,9 @@ fn Term prim_fn_write_bytes_go_io(Term *args) { head = wnf(head); // wnf(head) must be #BYT{b} - if (term_tag(head) != C01 || term_ext(head) != NAM_BYT) { + if (term_tag(head) != C01 || term_ext(head) != SYM_BYT) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } Term b_loc = term_val(head); @@ -584,14 +584,14 @@ fn Term prim_fn_write_bytes_go_io(Term *args) { // b in #BYT{b} must be NUM if (term_tag(b_trm) != NUM) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } // NUM must fit one byte. u32 b = term_val(b_trm); if (b > 0xFF) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(DATA_INVALID_BYTE_FMT, (unsigned long long)b, data_i) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(DATA_INVALID_BYTE_FMT, (unsigned long long)b, data_i) }); } unsigned char out = (unsigned char)b; @@ -599,32 +599,32 @@ fn Term prim_fn_write_bytes_go_io(Term *args) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(WRITE_IO_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(WRITE_IO_ERR_FMT, path, strerror(err), err) }); } data_i += 1; data_item = wnf(tail); } - if (term_tag(data_item) != C00 || term_ext(data_item) != NAM_NIL) { + if (term_tag(data_item) != C00 || term_ext(data_item) != SYM_NIL) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } if (fflush(file) != 0) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(FLUSH_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(FLUSH_ERR_FMT, path, strerror(err), err) }); } if (fclose(file) != 0) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(CLOSE_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(CLOSE_ERR_FMT, path, strerror(err), err) }); } - Term Nil = term_new_ctr(NAM_NIL, 0, 0); - return term_new_ctr(NAM_OK, 1, &Nil); + Term Nil = term_new_ctr(SYM_NIL, 0, 0); + return term_new_ctr(SYM_OK, 1, &Nil); } fn void prim_write_bytes_init(void) { diff --git a/clang/prim/fn/write_file.c b/clang/prim/fn/write_file.c index 140953f1..d064458a 100644 --- a/clang/prim/fn/write_file.c +++ b/clang/prim/fn/write_file.c @@ -63,11 +63,11 @@ fn Term write_file_go_path(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %write_file_go_path(acc, #Nil, data) // ------------------------------------- write-file-go-path-nil // %write_file_go_data(acc(#Nil), λx.x, data) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term path = term_new_app(acc, nil); u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -76,7 +76,7 @@ fn Term write_file_go_path(Term *args) { Term t = term_new_pri(table_find("write_file_go_data", 18), 3, args0); return wnf(t); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %write_file_go_path(acc, #Con{h,t}, data) // ------------------------------------------ write-file-go-path-con // %write_file_go_path_chr(acc, h, t, data) @@ -129,7 +129,7 @@ fn Term write_file_go_path_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next_args[2] = {app, data}; Term next = term_new_pri(table_find("write_file", 10), 2, next_args); @@ -149,8 +149,8 @@ fn Term write_file_go_path_chr(Term *args) { Copy D = term_clone(lab, data); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term args0[2] = {app0, D.k0}; @@ -160,7 +160,7 @@ fn Term write_file_go_path_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %write_file_go_path_chr(acc, #Chr{c}, t, data) // ----------------------------------------------- write-file-go-path-chr-chr // %write_file_go_path_num(acc, c, t, data) @@ -179,7 +179,7 @@ fn Term write_file_go_path_chr(Term *args) { // ----------------------------------------- write-file-go-path-chr-default // %write_file_go_data(acc(#Con{h, t}), λx.x, data) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -213,9 +213,9 @@ fn Term write_file_go_path_num(Term *args) { // ↑(%write_file(acc(#Con{#Chr{x}, t}), data)) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term app = term_new_app(acc, con); Term next_args[2] = {app, data}; Term next = term_new_pri(table_find("write_file", 10), 2, next_args); @@ -233,12 +233,12 @@ fn Term write_file_go_path_num(Term *args) { Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); Copy D = term_clone(lab, data); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term app0 = term_new_app(A.k0, con0); Term app1 = term_new_app(A.k1, con1); Term args0[2] = {app0, D.k0}; @@ -253,9 +253,9 @@ fn Term write_file_go_path_num(Term *args) { // %write_file_go_path(λx.acc(#Con{#Chr{n}, x}), t, data) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[3] = {acc_next, tail, data}; @@ -266,9 +266,9 @@ fn Term write_file_go_path_num(Term *args) { // %write_file_go_path_num(acc, c, t, data) // ----------------------------------------- write-file-go-path-num-default // %write_file_go_data(acc(#Con{#Chr{c}, t}), λx.x, data) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term path = term_new_app(acc, con); u64 loc = heap_alloc(1); Term var = term_new_var(loc); @@ -326,17 +326,17 @@ fn Term write_file_go_data(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == NAM_NIL) { + if (term_tag(list_wnf) == C00 && term_ext(list_wnf) == SYM_NIL) { // %write_file_go_data(path, acc, #Nil) // ------------------------------------ write-file-go-data-nil // %write_file_go_io(path, acc(#Nil)) - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term data = term_new_app(acc, nil); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); return wnf(io); } - if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == NAM_CON) { + if (term_tag(list_wnf) == C02 && term_ext(list_wnf) == SYM_CON) { // %write_file_go_data(path, acc, #Con{h,t}) // ----------------------------------------- write-file-go-data-con // %write_file_go_data_chr(path, acc, h, t) @@ -386,7 +386,7 @@ fn Term write_file_go_data_chr(Term *args) { u32 inc_loc = term_val(head_wnf); Term inner = heap_read(inc_loc); Term con_args[2] = {inner, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term next_args[2] = {path, data}; Term next = term_new_pri(table_find("write_file", 10), 2, next_args); @@ -406,8 +406,8 @@ fn Term write_file_go_data_chr(Term *args) { Copy T = term_clone(lab, tail); Term con0_args[2] = {x, T.k0}; Term con1_args[2] = {y, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term data0 = term_new_app(A.k0, con0); Term data1 = term_new_app(A.k1, con1); Term args0[2] = {P.k0, data0}; @@ -417,7 +417,7 @@ fn Term write_file_go_data_chr(Term *args) { return term_new_sup(lab, t0, t1); } case C00 ... C16: { - if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == NAM_CHR) { + if (term_tag(head_wnf) == C01 && term_ext(head_wnf) == SYM_CHR) { // %write_file_go_data_chr(path, acc, #Chr{c}, t) // ----------------------------------------------- write-file-go-data-chr-chr // %write_file_go_data_num(path, acc, c, t) @@ -436,7 +436,7 @@ fn Term write_file_go_data_chr(Term *args) { // ----------------------------------------- write-file-go-data-chr-default // %write_file_go_io(path, acc(#Con{h, t})) Term con_args[2] = {head_wnf, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); @@ -467,9 +467,9 @@ fn Term write_file_go_data_num(Term *args) { // ↑(%write_file(path, acc(#Con{#Chr{x}, t}))) u32 inc_loc = term_val(code_wnf); Term inner = heap_read(inc_loc); - Term chr = term_new_ctr(NAM_CHR, 1, &inner); + Term chr = term_new_ctr(SYM_CHR, 1, &inner); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term next_args[2] = {path, data}; Term next = term_new_pri(table_find("write_file", 10), 2, next_args); @@ -487,12 +487,12 @@ fn Term write_file_go_data_num(Term *args) { Copy P = term_clone(lab, path); Copy A = term_clone(lab, acc); Copy T = term_clone(lab, tail); - Term chr0 = term_new_ctr(NAM_CHR, 1, &x); - Term chr1 = term_new_ctr(NAM_CHR, 1, &y); + Term chr0 = term_new_ctr(SYM_CHR, 1, &x); + Term chr1 = term_new_ctr(SYM_CHR, 1, &y); Term con0_args[2] = {chr0, T.k0}; Term con1_args[2] = {chr1, T.k1}; - Term con0 = term_new_ctr(NAM_CON, 2, con0_args); - Term con1 = term_new_ctr(NAM_CON, 2, con1_args); + Term con0 = term_new_ctr(SYM_CON, 2, con0_args); + Term con1 = term_new_ctr(SYM_CON, 2, con1_args); Term data0 = term_new_app(A.k0, con0); Term data1 = term_new_app(A.k1, con1); Term args0[2] = {P.k0, data0}; @@ -507,9 +507,9 @@ fn Term write_file_go_data_num(Term *args) { // %write_file_go_data(path, λx.acc(#Con{#Chr{n}, x}), t) u64 loc = heap_alloc(1); Term var = term_new_var(loc); - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, var}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term bod = term_new_app(acc, con); Term acc_next = term_new_lam_at(loc, bod); Term args0[3] = {path, acc_next, tail}; @@ -520,9 +520,9 @@ fn Term write_file_go_data_num(Term *args) { // %write_file_go_data_num(path, acc, c, t) // ----------------------------------------- write-file-go-data-num-default // %write_file_go_io(path, acc(#Con{#Chr{c}, t})) - Term chr = term_new_ctr(NAM_CHR, 1, &code_wnf); + Term chr = term_new_ctr(SYM_CHR, 1, &code_wnf); Term con_args[2] = {chr, tail}; - Term con = term_new_ctr(NAM_CON, 2, con_args); + Term con = term_new_ctr(SYM_CON, 2, con_args); Term data = term_new_app(acc, con); Term io_args[2] = {path, data}; Term io = term_new_pri(table_find("write_file_go_io", 16), 2, io_args); @@ -555,16 +555,16 @@ fn Term prim_fn_write_file_go_io(Term *args) { FILE *file = fopen(path, "wb"); if (!file) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(OPEN_PATH_ERR_FMT, path, strerror(err), err) }); } // Write hvm4 string List<#CHR{NUM}> into file as UTF-8 bytes. data_item = wnf(data_item); while (term_tag(data_item) == C02) { // wnf(data_item) must be List<#CHR{c}> - if (term_ext(data_item) != NAM_CON) { + if (term_ext(data_item) != SYM_CON) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } Term head_loc = term_val(data_item); @@ -573,9 +573,9 @@ fn Term prim_fn_write_file_go_io(Term *args) { head = wnf(head); // wnf(head) must be #CHR{c} - if (term_tag(head) != C01 || term_ext(head) != NAM_CHR) { + if (term_tag(head) != C01 || term_ext(head) != SYM_CHR) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } Term c_loc = term_val(head); @@ -584,7 +584,7 @@ fn Term prim_fn_write_file_go_io(Term *args) { // c in #CHR{c} must be NUM if (term_tag(c_trm) != NUM) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } // Encode UTF-32 codepoint (NUM) into UTF-8 bytes. @@ -593,39 +593,39 @@ fn Term prim_fn_write_file_go_io(Term *args) { int n_bytes = utf8_encode_scalar(cp, cp_utf8); if (n_bytes < 0) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(DATA_INVALID_CP_FMT, (unsigned long long)cp, data_i) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(DATA_INVALID_CP_FMT, (unsigned long long)cp, data_i) }); } if (fwrite(cp_utf8, 1, (size_t)n_bytes, file) != (size_t)n_bytes) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(WRITE_IO_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(WRITE_IO_ERR_FMT, path, strerror(err), err) }); } data_i += 1; data_item = wnf(tail); } - if (term_tag(data_item) != C00 || term_ext(data_item) != NAM_NIL) { + if (term_tag(data_item) != C00 || term_ext(data_item) != SYM_NIL) { fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf("%s", DATA_EXPECTED) }); } if (fflush(file) != 0) { // Capture errno before fclose because fclose may overwrite it. int err = errno; fclose(file); - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(FLUSH_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(FLUSH_ERR_FMT, path, strerror(err), err) }); } if (fclose(file) != 0) { int err = errno; - return term_new_ctr(NAM_ERR, 1, (Term[]){ term_string_printf(CLOSE_ERR_FMT, path, strerror(err), err) }); + return term_new_ctr(SYM_ERR, 1, (Term[]){ term_string_printf(CLOSE_ERR_FMT, path, strerror(err), err) }); } - Term Nil = term_new_ctr(NAM_NIL, 0, 0); - return term_new_ctr(NAM_OK, 1, &Nil); + Term Nil = term_new_ctr(SYM_NIL, 0, 0); + return term_new_ctr(SYM_OK, 1, &Nil); } fn void prim_write_file_init(void) { diff --git a/clang/prim/string.c b/clang/prim/string.c index 2786237d..95864a16 100644 --- a/clang/prim/string.c +++ b/clang/prim/string.c @@ -226,13 +226,13 @@ fn int term_chr_from_scalar(u32 cp, Term *out) { } Term num = term_new_num(cp); - *out = term_new_ctr(NAM_CHR, 1, &num); + *out = term_new_ctr(SYM_CHR, 1, &num); return 1; } // NOTE: Assumes `s` is a NUL-terminated UTF-8 C string. fn Term term_string_from_utf8(const char *s) { - Term nil = term_new_ctr(NAM_NIL, 0, 0); + Term nil = term_new_ctr(SYM_NIL, 0, 0); Term out = nil; Term cur = nil; u32 idx = 0; @@ -258,7 +258,7 @@ fn Term term_string_from_utf8(const char *s) { } Term args[2] = {chr, nil}; - Term node = term_new_ctr(NAM_CON, 2, args); + Term node = term_new_ctr(SYM_CON, 2, args); if (!has_node) { out = node; @@ -340,7 +340,7 @@ fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStr while (term_tag(cur) == C02 && len < cap) { // wnf(cur) must be List<#CHR{c}> - if (term_ext(cur) != NAM_CON) { + if (term_ext(cur) != SYM_CON) { hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); return 0; } @@ -350,7 +350,7 @@ fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStr Term tail = heap_read(loc + 1); // wnf(head) must be #CHR{c} - if (term_tag(head) != C01 || term_ext(head) != NAM_CHR) { + if (term_tag(head) != C01 || term_ext(head) != SYM_CHR) { hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); return 0; } @@ -384,7 +384,7 @@ fn int term_string_to_utf8_cstr(Term src, char *dst, int cap, int *out_len, HStr hstr_set(err, HSTR_TOO_LONG, i, len, 0); return 0; } - if (term_tag(cur) != C00 || term_ext(cur) != NAM_NIL) { + if (term_tag(cur) != C00 || term_ext(cur) != SYM_NIL) { hstr_set(err, HSTR_BAD_SHAPE, i, len, 0); return 0; } @@ -433,5 +433,5 @@ fn Term term_string_from_hstrerr(const char *prim, const char *arg, int cap, HSt msg = term_string_printf("%sinvalid `%s`", prefix, arg); break; } - return term_new_ctr(NAM_ERR, 1, &msg); + return term_new_ctr(SYM_ERR, 1, &msg); } diff --git a/test/prim_argv_echo.hvm b/test/prim_argv_echo.hvm new file mode 100644 index 00000000..b6caad82 --- /dev/null +++ b/test/prim_argv_echo.hvm @@ -0,0 +1,4 @@ +//! -- hello +@main = %log(λ{[]: "no argv"; <>: λx,t. x}(%argv([]))) +//!hello +//![] From 96f27611d27ee033fa0f1883507134150d7b6601 Mon Sep 17 00:00:00 2001 From: Paulo Cavalcanti Date: Thu, 26 Feb 2026 18:50:57 +0400 Subject: [PATCH 35/35] Align prim and stdlib constructor shapes with pseudotypes --- clang/prim/fn/http/_.c | 8 ++++---- clang/prim/fn/stream/_.c | 22 +++++++++++----------- clang/prim/fn/stream/poll.c | 2 +- clang/prim/fn/stream/wait.c | 2 +- clang/prim/fn/tcp/_.c | 10 +++++----- clang/prim/fn/tcp/close.c | 2 +- clang/prim/fn/tcp/connect_poll.c | 2 +- clang/prim/fn/tcp/connect_wait.c | 2 +- clang/prim/fn/tcp/recv_poll.c | 2 +- clang/prim/fn/tcp/recv_wait.c | 2 +- clang/prim/fn/tcp/send_poll.c | 2 +- clang/prim/fn/tcp/send_wait.c | 2 +- clang/prim/fn/timer/_.c | 6 +++++- clang/prim/fn/timer/poll.c | 2 +- clang/prim/fn/timer/wait.c | 2 +- examples/http_get_basic.hvm4 | 2 +- examples/stream_file_read_all.hvm4 | 4 ++-- examples/stream_stdin_line.hvm4 | 18 +++++++++++------- examples/tcp_echo_client.hvm4 | 4 ++-- stdlib/stream.hvm4 | 4 ++-- stdlib/tcp.hvm4 | 2 +- stdlib/timer.hvm4 | 2 +- test/prim_stream_poll_file_eof.hvm4 | 2 +- test/prim_stream_wait_file_eof.hvm4 | 2 +- test/prim_timer_bind.hvm4 | 2 +- test/prim_timer_inc.hvm4 | 2 +- test/prim_timer_sup.hvm4 | 2 +- test/prim_timer_wait_zero.hvm4 | 2 +- 28 files changed, 62 insertions(+), 54 deletions(-) diff --git a/clang/prim/fn/http/_.c b/clang/prim/fn/http/_.c index cca6afdf..073fe740 100644 --- a/clang/prim/fn/http/_.c +++ b/clang/prim/fn/http/_.c @@ -1476,14 +1476,14 @@ fn void prim_http_init(void) { HTTP_NAM_RDY = table_find("Rdy", 3); HTTP_NAM_RESP = table_find("Resp", 4); HTTP_NAM_HDR = table_find("Hdr", 3); - HTTP_NAM_FAIL = table_find("Fail", 4); + HTTP_NAM_FAIL = table_find("HttpFail", 8); HTTP_NAM_CANCELED = table_find("Canceled", 8); - HTTP_NAM_TIMEOUT = table_find("Timeout", 7); - HTTP_NAM_DNS = table_find("Dns", 3); + HTTP_NAM_TIMEOUT = table_find("HttpTimeout", 11); + HTTP_NAM_DNS = table_find("HttpDns", 7); HTTP_NAM_CONNECT = table_find("Connect", 7); HTTP_NAM_TLS = table_find("Tls", 3); - HTTP_NAM_PROTOCOL = table_find("Protocol", 8); + HTTP_NAM_PROTOCOL = table_find("HttpProtocol", 12); HTTP_NAM_CURL_EXIT = table_find("CurlExit", 8); HTTP_NAM_CURL_SIGNAL = table_find("CurlSignal", 10); HTTP_NAM_PARSE = table_find("Parse", 5); diff --git a/clang/prim/fn/stream/_.c b/clang/prim/fn/stream/_.c index e6a80b4f..476c22aa 100644 --- a/clang/prim/fn/stream/_.c +++ b/clang/prim/fn/stream/_.c @@ -27,7 +27,8 @@ static pthread_mutex_t STREAM_LOCK = PTHREAD_MUTEX_INITIALIZER; static u32 STREAM_NAM_STRM = 0; static u32 STREAM_NAM_PEND = 0; static u32 STREAM_NAM_RDY = 0; -static u32 STREAM_NAM_EOF = 0; +static u32 STREAM_NAM_STREAM_BYTE = 0; +static u32 STREAM_NAM_STREAM_EOF = 0; fn Term wnf(Term term); @@ -50,13 +51,10 @@ fn Term stream_new_pend(u32 id, u32 seq) { return term_new_ctr(STREAM_NAM_PEND, 1, &strm); } -fn Term stream_new_byt(u32 byt) { - Term arg = term_new_num(byt); - return term_new_ctr(SYM_BYT, 1, &arg); -} - -fn Term stream_new_eof(void) { - return term_new_ctr(STREAM_NAM_EOF, 0, NULL); +fn Term stream_new_stream_byte(u32 byte) { + Term num = term_new_num(byte); + Term byt = term_new_ctr(SYM_BYT, 1, &num); + return term_new_ctr(STREAM_NAM_STREAM_BYTE, 1, &byt); } fn Term stream_new_rdy_payload(u32 id, u32 seq, Term payload) { @@ -66,11 +64,12 @@ fn Term stream_new_rdy_payload(u32 id, u32 seq, Term payload) { } fn Term stream_new_rdy_byt(u32 id, u32 seq, u32 byt) { - return stream_new_rdy_payload(id, seq, stream_new_byt(byt)); + return stream_new_rdy_payload(id, seq, stream_new_stream_byte(byt)); } fn Term stream_new_rdy_eof(u32 id, u32 seq) { - return stream_new_rdy_payload(id, seq, stream_new_eof()); + Term eof = term_new_ctr(STREAM_NAM_STREAM_EOF, 0, NULL); + return stream_new_rdy_payload(id, seq, eof); } fn u8 stream_parse_num(Term term, u32 *out) { @@ -224,7 +223,8 @@ fn void prim_stream_init(void) { STREAM_NAM_STRM = table_find("Strm", 4); STREAM_NAM_PEND = table_find("Pend", 4); STREAM_NAM_RDY = table_find("Rdy", 3); - STREAM_NAM_EOF = table_find("Eof", 3); + STREAM_NAM_STREAM_BYTE = table_find("StreamByte", 10); + STREAM_NAM_STREAM_EOF = table_find("StreamEof", 9); prim_stream_stdin_open_init(); prim_stream_file_open_init(); diff --git a/clang/prim/fn/stream/poll.c b/clang/prim/fn/stream/poll.c index 2126e195..71590e89 100644 --- a/clang/prim/fn/stream/poll.c +++ b/clang/prim/fn/stream/poll.c @@ -55,7 +55,7 @@ fn Term stream_poll_go_strm(Term *args) { // %stream_poll_go_io(strm) // ------------------------ -// #OK{#Pend{#Strm{id,seq+1}}|#Rdy{#Strm{id,seq+1},#BYT{n}|#Eof}} | #ERR{String} +// #OK{#Pend{#Strm{id,seq+1}}|#Rdy{#Strm{id,seq+1},#StreamByte{#BYT{n}}|#StreamEof{}}} | #ERR{String} fn Term prim_fn_stream_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/stream/wait.c b/clang/prim/fn/stream/wait.c index 1c62c009..d246ca69 100644 --- a/clang/prim/fn/stream/wait.c +++ b/clang/prim/fn/stream/wait.c @@ -55,7 +55,7 @@ fn Term stream_wait_go_strm(Term *args) { // %stream_wait_go_io(strm) // ------------------------ -// #OK{#Rdy{#Strm{id,seq+1},#BYT{n}|#Eof}} | #ERR{String} +// #OK{#Rdy{#Strm{id,seq+1},#StreamByte{#BYT{n}}|#StreamEof{}}} | #ERR{String} fn Term prim_fn_stream_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/_.c b/clang/prim/fn/tcp/_.c index 9c2efa0a..2405ea2a 100644 --- a/clang/prim/fn/tcp/_.c +++ b/clang/prim/fn/tcp/_.c @@ -680,17 +680,17 @@ fn void prim_tcp_init(void) { TCP_NAM_CONN = table_find("Conn", 4); TCP_NAM_RECV = table_find("Recv", 4); TCP_NAM_SENT = table_find("Sent", 4); - TCP_NAM_EOF = table_find("Eof", 3); + TCP_NAM_EOF = table_find("TcpEof", 6); TCP_NAM_CLOSED = table_find("Closed", 6); - TCP_NAM_FAIL = table_find("Fail", 4); + TCP_NAM_FAIL = table_find("TcpFail", 7); - TCP_NAM_TIMEOUT = table_find("Timeout", 7); - TCP_NAM_DNS = table_find("Dns", 3); + TCP_NAM_TIMEOUT = table_find("TcpTimeout", 10); + TCP_NAM_DNS = table_find("TcpDns", 6); TCP_NAM_REFUSED = table_find("Refused", 7); TCP_NAM_UNREACHABLE = table_find("Unreachable", 11); TCP_NAM_RESET = table_find("Reset", 5); TCP_NAM_BROKEN_PIPE = table_find("BrokenPipe", 10); - TCP_NAM_PROTOCOL = table_find("Protocol", 8); + TCP_NAM_PROTOCOL = table_find("TcpProtocol", 11); TCP_NAM_NOT_CONNECTED = table_find("NotConnected", 12); TCP_NAM_SYS = table_find("Sys", 3); diff --git a/clang/prim/fn/tcp/close.c b/clang/prim/fn/tcp/close.c index 665a4e85..092ad303 100644 --- a/clang/prim/fn/tcp/close.c +++ b/clang/prim/fn/tcp/close.c @@ -55,7 +55,7 @@ fn Term tcp_close_go_tcp(Term *args) { // %tcp_close_go_io(tcp) // --------------------- -// #OK{#Rdy{#Tcp{id,seq+1},#Closed{}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Rdy{#Tcp{id,seq+1},#Closed{}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_close_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/connect_poll.c b/clang/prim/fn/tcp/connect_poll.c index ce8c4e2d..b474d98c 100644 --- a/clang/prim/fn/tcp/connect_poll.c +++ b/clang/prim/fn/tcp/connect_poll.c @@ -55,7 +55,7 @@ fn Term tcp_connect_poll_go_tcp(Term *args) { // %tcp_connect_poll_go_io(tcp) // ---------------------------- -// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Conn{}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Conn{}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_connect_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/connect_wait.c b/clang/prim/fn/tcp/connect_wait.c index 105e5ebf..9f98746c 100644 --- a/clang/prim/fn/tcp/connect_wait.c +++ b/clang/prim/fn/tcp/connect_wait.c @@ -55,7 +55,7 @@ fn Term tcp_connect_wait_go_tcp(Term *args) { // %tcp_connect_wait_go_io(tcp) // ---------------------------- -// #OK{#Rdy{#Tcp{id,seq+1},#Conn{}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Rdy{#Tcp{id,seq+1},#Conn{}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_connect_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/recv_poll.c b/clang/prim/fn/tcp/recv_poll.c index 30bf480d..f1bf47b1 100644 --- a/clang/prim/fn/tcp/recv_poll.c +++ b/clang/prim/fn/tcp/recv_poll.c @@ -111,7 +111,7 @@ fn Term tcp_recv_poll_go_max(Term *args) { // %tcp_recv_poll_go_io(tcp, max_bytes) // ------------------------------------ -// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Recv{bytes}|#Eof{}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Recv{bytes}|#TcpEof{}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_recv_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/recv_wait.c b/clang/prim/fn/tcp/recv_wait.c index c6c57cea..58ba6e19 100644 --- a/clang/prim/fn/tcp/recv_wait.c +++ b/clang/prim/fn/tcp/recv_wait.c @@ -111,7 +111,7 @@ fn Term tcp_recv_wait_go_max(Term *args) { // %tcp_recv_wait_go_io(tcp, max_bytes) // ------------------------------------ -// #OK{#Rdy{#Tcp{id,seq+1},#Recv{bytes}|#Eof{}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Rdy{#Tcp{id,seq+1},#Recv{bytes}|#TcpEof{}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_recv_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/send_poll.c b/clang/prim/fn/tcp/send_poll.c index 9570d70b..11065543 100644 --- a/clang/prim/fn/tcp/send_poll.c +++ b/clang/prim/fn/tcp/send_poll.c @@ -111,7 +111,7 @@ fn Term tcp_send_poll_go_bytes(Term *args) { // %tcp_send_poll_go_io(tcp, bytes) // -------------------------------- -// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Sent{n}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Pend{#Tcp{id,seq+1}}|#Rdy{#Tcp{id,seq+1},#Sent{n}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_send_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/tcp/send_wait.c b/clang/prim/fn/tcp/send_wait.c index c6114bbb..57bfaf0b 100644 --- a/clang/prim/fn/tcp/send_wait.c +++ b/clang/prim/fn/tcp/send_wait.c @@ -111,7 +111,7 @@ fn Term tcp_send_wait_go_bytes(Term *args) { // %tcp_send_wait_go_io(tcp, bytes) // -------------------------------- -// #OK{#Rdy{#Tcp{id,seq+1},#Sent{n}|#Fail{reason,msg}}} | #ERR{String} +// #OK{#Rdy{#Tcp{id,seq+1},#Sent{n}|#TcpFail{reason,msg}}} | #ERR{String} fn Term prim_fn_tcp_send_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/timer/_.c b/clang/prim/fn/timer/_.c index 6c80bdb4..79d4e608 100644 --- a/clang/prim/fn/timer/_.c +++ b/clang/prim/fn/timer/_.c @@ -17,6 +17,7 @@ static pthread_mutex_t TIMER_LOCK = PTHREAD_MUTEX_INITIALIZER; static u32 TIMER_NAM_TIME = 0; static u32 TIMER_NAM_PEND = 0; static u32 TIMER_NAM_RDY = 0; +static u32 TIMER_NAM_NONE = 0; fn Term wnf(Term term); @@ -60,7 +61,9 @@ fn Term timer_new_pend(u32 id, u32 seq) { fn Term timer_new_rdy(u32 id, u32 seq) { Term time = timer_new_time(id, seq); - return term_new_ctr(TIMER_NAM_RDY, 1, &time); + Term none = term_new_ctr(TIMER_NAM_NONE, 0, NULL); + Term args[2] = {time, none}; + return term_new_ctr(TIMER_NAM_RDY, 2, args); } fn u8 timer_parse_num(Term term, u32 *out) { @@ -144,6 +147,7 @@ fn void prim_timer_init(void) { TIMER_NAM_TIME = table_find("Time", 4); TIMER_NAM_PEND = table_find("Pend", 4); TIMER_NAM_RDY = table_find("Rdy", 3); + TIMER_NAM_NONE = table_find("None", 4); prim_timer_start_init(); prim_timer_poll_init(); diff --git a/clang/prim/fn/timer/poll.c b/clang/prim/fn/timer/poll.c index 925ca021..c2fe6e08 100644 --- a/clang/prim/fn/timer/poll.c +++ b/clang/prim/fn/timer/poll.c @@ -55,7 +55,7 @@ fn Term timer_poll_go_time(Term *args) { // %timer_poll_go_io(time) // ----------------------- -// #OK{#Pend{#Time{id,seq+1}}|#Rdy{#Time{id,seq+1}}} | #ERR{String} +// #OK{#Pend{#Time{id,seq+1}}|#Rdy{#Time{id,seq+1},#None{}}} | #ERR{String} fn Term prim_fn_timer_poll_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/clang/prim/fn/timer/wait.c b/clang/prim/fn/timer/wait.c index 01361fe5..3ca75a52 100644 --- a/clang/prim/fn/timer/wait.c +++ b/clang/prim/fn/timer/wait.c @@ -55,7 +55,7 @@ fn Term timer_wait_go_time(Term *args) { // %timer_wait_go_io(time) // ----------------------- -// #OK{#Rdy{#Time{id,seq+1}}} | #ERR{String} +// #OK{#Rdy{#Time{id,seq+1},#None{}}} | #ERR{String} fn Term prim_fn_timer_wait_go_io(Term *args) { u32 id = 0; u32 seq = 0; diff --git a/examples/http_get_basic.hvm4 b/examples/http_get_basic.hvm4 index bafd942c..e63cca3e 100644 --- a/examples/http_get_basic.hvm4 +++ b/examples/http_get_basic.hvm4 @@ -6,7 +6,7 @@ @resp_to_status_body = λev. λ{ #Resp: λstatus. λheaders. λbody.@pure(#P{status, body}); - #Fail: λreason. λmsg.#ERR{msg}; + #HttpFail: λreason. λmsg.#ERR{msg}; #Canceled: #ERR{"http request canceled"}; &{} }(ev) diff --git a/examples/stream_file_read_all.hvm4 b/examples/stream_file_read_all.hvm4 index 6fd2285d..226bc5c0 100644 --- a/examples/stream_file_read_all.hvm4 +++ b/examples/stream_file_read_all.hvm4 @@ -7,8 +7,8 @@ !&h = @fst(w2); ! e = @snd(w2); λ{ - #BYT: λn.@stream_read_all(h, #BYT{n} <> acc); - #Eof: @pure(#P{h, @list_rev(acc)}); + #StreamByte: λb.@stream_read_all(h, b <> acc); + #StreamEof: @pure(#P{h, @list_rev(acc)}); &{} }(e) diff --git a/examples/stream_stdin_line.hvm4 b/examples/stream_stdin_line.hvm4 index 5afb681c..7dfc5bcd 100644 --- a/examples/stream_stdin_line.hvm4 +++ b/examples/stream_stdin_line.hvm4 @@ -7,14 +7,18 @@ !&h = @fst(w2); ! e = @snd(w2); λ{ - #BYT: λn. + #StreamByte: λb. λ{ - 10: - @pure(#P{h, @list_rev(acc)}); - λx. - @stream_read_line(h, #BYT{x} <> acc) - }(n); - #Eof: + #BYT: λn. + λ{ + 10: + @pure(#P{h, @list_rev(acc)}); + λx. + @stream_read_line(h, #BYT{x} <> acc) + }(n); + &{} + }(b); + #StreamEof: @pure(#P{h, @list_rev(acc)}); &{} }(e) diff --git a/examples/tcp_echo_client.hvm4 b/examples/tcp_echo_client.hvm4 index 66ea6c41..e1f540bf 100644 --- a/examples/tcp_echo_client.hvm4 +++ b/examples/tcp_echo_client.hvm4 @@ -6,8 +6,8 @@ @decode_recv_evt = λev. λ{ #Recv: λbs.@bytes_to_string(bs); - #Eof: @pure(""); - #Fail: λreason. λmsg.#ERR{msg}; + #TcpEof: @pure(""); + #TcpFail: λreason. λmsg.#ERR{msg}; &{} }(ev) diff --git a/stdlib/stream.hvm4 b/stdlib/stream.hvm4 index 092dc6bb..9481d397 100644 --- a/stdlib/stream.hvm4 +++ b/stdlib/stream.hvm4 @@ -31,8 +31,8 @@ ! e = @snd(wr); !&a = acc; λ{ - #BYT: λn.@stream_read_all_go(h, #BYT{n} <> a); - #Eof: @pure(#P{h, @list_rev(a)}); + #StreamByte: λb.@stream_read_all_go(h, b <> a); + #StreamEof: @pure(#P{h, @list_rev(a)}); &{} }(e) ) diff --git a/stdlib/tcp.hvm4 b/stdlib/tcp.hvm4 index dff2e240..ff6fa2a9 100644 --- a/stdlib/tcp.hvm4 +++ b/stdlib/tcp.hvm4 @@ -37,7 +37,7 @@ ! h = @fst(w); λ{ #Conn: @pure(h); - #Fail: λreason. λmsg.#ERR{msg}; + #TcpFail: λreason. λmsg.#ERR{msg}; &{} }(@snd(w)) diff --git a/stdlib/timer.hvm4 b/stdlib/timer.hvm4 index 6901638e..bad38f19 100644 --- a/stdlib/timer.hvm4 +++ b/stdlib/timer.hvm4 @@ -9,7 +9,7 @@ %timer_poll(t) @timer_wait = λt. - @wait(%timer_wait(t), @decode_wait_h) + @map(@wait(%timer_wait(t), @decode_wait_he), @fst) @sleep_ms = λms. ! f0 = λ t0 ; diff --git a/test/prim_stream_poll_file_eof.hvm4 b/test/prim_stream_poll_file_eof.hvm4 index 2d8cabfc..da32ec93 100644 --- a/test/prim_stream_poll_file_eof.hvm4 +++ b/test/prim_stream_poll_file_eof.hvm4 @@ -1,4 +1,4 @@ @main = !!x = %stream_file_open("/dev/null"); %stream_poll(#Strm{1,0}) -//!#OK{#Rdy{#Strm{1,1},#Eof{}}} +//!#OK{#Rdy{#Strm{1,1},#StreamEof{}}} diff --git a/test/prim_stream_wait_file_eof.hvm4 b/test/prim_stream_wait_file_eof.hvm4 index 188eb054..840e2d77 100644 --- a/test/prim_stream_wait_file_eof.hvm4 +++ b/test/prim_stream_wait_file_eof.hvm4 @@ -1,4 +1,4 @@ @main = !!x = %stream_file_open("/dev/null"); %stream_wait(#Strm{1,0}) -//!#OK{#Rdy{#Strm{1,1},#Eof{}}} +//!#OK{#Rdy{#Strm{1,1},#StreamEof{}}} diff --git a/test/prim_timer_bind.hvm4 b/test/prim_timer_bind.hvm4 index a83357ac..1c511324 100644 --- a/test/prim_timer_bind.hvm4 +++ b/test/prim_timer_bind.hvm4 @@ -6,4 +6,4 @@ }(r) @main = @bind(%timer_start(0), λh.%timer_wait(h)) -//!#OK{#Rdy{#Time{1,1}}} +//!#OK{#Rdy{#Time{1,1},#None{}}} diff --git a/test/prim_timer_inc.hvm4 b/test/prim_timer_inc.hvm4 index 16257e42..6e0e93cc 100644 --- a/test/prim_timer_inc.hvm4 +++ b/test/prim_timer_inc.hvm4 @@ -1,4 +1,4 @@ @main = !!x = %timer_start(0); %timer_wait(↑#Time{1,0}) -//!↑#OK{#Rdy{#Time{1,1}}} +//!↑#OK{#Rdy{#Time{1,1},#None{}}} diff --git a/test/prim_timer_sup.hvm4 b/test/prim_timer_sup.hvm4 index aedb7f04..c57c54aa 100644 --- a/test/prim_timer_sup.hvm4 +++ b/test/prim_timer_sup.hvm4 @@ -2,4 +2,4 @@ !!a = %timer_start(0); !!b = %timer_start(0); %timer_wait(&L{#Time{1,0}, #Time{2,0}}) -//!&L{#OK{#Rdy{#Time{1,1}}},#OK{#Rdy{#Time{2,1}}}} +//!&L{#OK{#Rdy{#Time{1,1},#None{}}},#OK{#Rdy{#Time{2,1},#None{}}}} diff --git a/test/prim_timer_wait_zero.hvm4 b/test/prim_timer_wait_zero.hvm4 index f7de372f..d0428897 100644 --- a/test/prim_timer_wait_zero.hvm4 +++ b/test/prim_timer_wait_zero.hvm4 @@ -1,4 +1,4 @@ @main = !!x = %timer_start(0); %timer_wait(#Time{1,0}) -//!#OK{#Rdy{#Time{1,1}}} +//!#OK{#Rdy{#Time{1,1},#None{}}}