add io ext

1 files changed, 295 insertions, 0 deletions

diff --git a/exts/io.c b/exts/io.c
new file mode 100644
index 0000000..76c1520
--- /dev/null
+++ b/exts/io.c
@@ -0,0 +1,295 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+
+#include <bamboo_lisp/interp.h>
+#include <bamboo_lisp/sexp.h>
+
+#define STREAM_TYPEID "ext.core.stream"
+
+typedef struct {
+    FILE *fp;
+    bool should_close;
+} LispStream;
+
+LispUserdataMeta bamboo_lisp_stream_meta;
+
+static bool is_stream_impl(Interp *interp, SExpRef obj) {
+    if (VALTYPE(obj) == kUserDataSExp && 
+        strcmp(STREAM_TYPEID, REF(obj)->userdata_meta->type) == 0) {
+        return true;
+    }
+    return false;
+}
+
+static SExpRef make_stream(Interp* interp, FILE *fp, bool should_close) {
+    SExpRef ret = new_sexp(interp);
+    REF(ret)->type = kUserDataSExp;
+    REF(ret)->userdata_meta = &bamboo_lisp_stream_meta;
+    
+    LispStream *s = malloc(sizeof(LispStream));
+    s->fp = fp;
+    s->should_close = should_close;
+    
+    REF(ret)->userdata = s;
+    return ret;
+}
+
+static FILE* get_input_stream(Interp* interp, SExpRef args, const char* func_name) {
+    if (NILP(args)) return stdin;
+    
+    SExpRef first = CAR(args);
+    if (!is_stream_impl(interp, first)) {
+        new_error(interp, "%s: argument is not a stream.\n", func_name);
+        return NULL;
+    }
+    LispStream *s = (LispStream*)REF(first)->userdata;
+    return s->fp;
+}
+
+static FILE* get_output_stream(Interp* interp, SExpRef args, const char* func_name) {
+    if (NILP(args)) return stdout;
+    
+    SExpRef first = CAR(args);
+    if (!is_stream_impl(interp, first)) {
+        new_error(interp, "%s: argument is not a stream.\n", func_name);
+        return NULL;
+    }
+    LispStream *s = (LispStream*)REF(first)->userdata;
+    return s->fp;
+}
+
+// (stream? obj)
+static SExpRef ext_is_stream(Interp* interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "stream?: wrong args num.\n");
+    return new_boolean(interp, is_stream_impl(interp, CAR(args)));
+}
+
+// (open-file filename mode) -> stream
+static SExpRef ext_open_file(Interp* interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "open-file: wrong args num.\n");
+    
+    SExpRef arg_fname = CAR(args);
+    SExpRef arg_mode = CADR(args);
+
+    if (VALTYPE(arg_fname) != kStringSExp || VALTYPE(arg_mode) != kStringSExp) {
+        return new_error(interp, "open-file: filename and mode must be strings.\n");
+    }
+
+    const char *fname = REF(arg_fname)->str;
+    const char *mode = REF(arg_mode)->str;
+
+    FILE *fp = fopen(fname, mode);
+    if (!fp) {
+        return new_error(interp, "open-file: failed to open file '%s'.\n", fname);
+    }
+
+    return make_stream(interp, fp, true);
+}
+
+// (read-char [stream])
+static SExpRef ext_read_char(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-char: too many args.\n");
+    
+    FILE *fp = get_input_stream(interp, args, "read-char");
+    if (!fp) return NIL; // Error handled in get_input_stream but returns NULL
+
+    int c = fgetc(fp);
+    if (c == EOF) return NIL; // End of file returns NIL
+
+    return new_char(interp, (char)c);
+}
+
+// (read-integer [stream])
+static SExpRef ext_read_integer(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-integer: too many args.\n");
+
+    FILE *fp = get_input_stream(interp, args, "read-integer");
+    if (!fp) return NIL;
+
+    long long val;
+
+    int c;
+    while(isspace(c = fgetc(fp)));
+    ungetc(c, fp);
+
+    if (fscanf(fp, "%lld", &val) == 1) {
+        return new_integer(interp, val);
+    }
+    return NIL;
+}
+
+static SExpRef ext_read_number(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-number: too many args.\n");
+
+    FILE *fp = get_input_stream(interp, args, "read-number");
+    if (!fp) return NIL;
+
+    char buffer[64];
+    int idx = 0;
+    int c;
+
+    while ((c = fgetc(fp)) != EOF && isspace(c));
+    
+    if (c == EOF) return NIL;
+
+    do {
+        if (idx < 63) buffer[idx++] = (char)c;
+        c = fgetc(fp);
+    } while (c != EOF && !isspace(c) && c != ')' && c != '(');
+    
+    if (c != EOF) ungetc(c, fp);
+    buffer[idx] = '\0';
+
+    if (strchr(buffer, '.') != NULL) {
+        char *end;
+        double d = strtod(buffer, &end);
+        if (end != buffer) return new_real(interp, d);
+    } else {
+        char *end;
+        long long i = strtoll(buffer, &end, 10);
+        if (end != buffer) return new_integer(interp, i);
+    }
+
+    return NIL;
+}
+
+static char* internal_read_line(FILE *fp) {
+    size_t cap = 128;
+    size_t len = 0;
+    char *buf = malloc(cap);
+    if (!buf) return NULL;
+
+    int c = fgetc(fp);
+    if (c == EOF) {
+        free(buf);
+        return NULL; 
+    }
+
+    while (c != EOF && c != '\n') {
+        if (len + 1 >= cap) {
+            cap *= 2;
+            char *new_buf = realloc(buf, cap);
+            if (!new_buf) { free(buf); return NULL; }
+            buf = new_buf;
+        }
+        buf[len++] = (char)c;
+        c = fgetc(fp);
+    }
+    buf[len] = '\0';
+    return buf;
+}
+
+// (read-line [stream])
+static SExpRef ext_read_line(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-line: too many args.\n");
+
+    FILE *fp = get_input_stream(interp, args, "read-line");
+    if (!fp) return NIL;
+
+    char *line = internal_read_line(fp);
+    if (line) {
+        SExpRef ret = new_string(interp, line);
+        free(line);
+        return ret;
+    }
+    return NIL;
+}
+
+// (lines stream) -> list of strings
+static SExpRef ext_lines(Interp* interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "lines: wrong args num.\n");
+    
+    FILE *fp = get_input_stream(interp, args, "lines");
+    if (!fp) return NIL;
+
+    SExpRef list_head = NIL;
+
+    char *line_str;
+    while ((line_str = internal_read_line(fp)) != NULL) {
+        SExpRef s = new_string(interp, line_str);
+        free(line_str);
+        list_head = CONS(s, list_head);
+    }
+
+    return lisp_nreverse(interp, list_head);
+}
+
+static SExpRef ext_stream_close(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "stream-close: wrong args num.\n");
+    SExpRef first = CAR(args);
+    if (!is_stream_impl(interp, first)) {
+        return new_error(interp, "stream-close: argument is not a stream.\n");
+    }
+    LispStream *s = (LispStream*)REF(first)->userdata;
+    if (s->should_close && s->fp != NULL) {
+        fclose(s->fp);
+        s->fp = NULL;
+        s->should_close = false;
+    }
+    return NIL;
+}
+
+// (write-char c [stream])
+static SExpRef ext_write_char(Interp* interp, SExpRef args) {
+    int len = LENGTH(args);
+    if (len < 1 || len > 2) return new_error(interp, "write-char: wrong args num.\n");
+
+    if (VALTYPE(CAR(args)) != kCharSExp) 
+        return new_error(interp, "write-char: first arg must be char.\n");
+    
+    char c = REF(CAR(args))->character;
+    
+    FILE *fp = get_output_stream(interp, CDR(args), "write-char"); // CDR is the rest of args
+    if (!fp) return NIL;
+
+    fputc(c, fp);
+    return NIL;
+}
+
+// (write-obj obj [stream])
+static SExpRef ext_write_obj(Interp* interp, SExpRef args) {
+    int len = LENGTH(args);
+    if (len < 1 || len > 2) return new_error(interp, "write-obj: wrong args num.\n");
+
+    SExpRef obj = CAR(args);
+    FILE *fp = get_output_stream(interp, CDR(args), "write-obj");
+    if (!fp) return NIL;
+
+    lisp_print(interp, obj, fp);
+    return NIL;
+}
+
+static void stream_free(void *vself) {
+    LispStream *self = (LispStream*)vself;
+    if (self->should_close && self->fp) {
+        fclose(self->fp);
+    }
+    free(self);
+}
+
+static void stream_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) {
+    (void)interp;
+    (void)gcstack;
+    (void)vself;
+}
+
+int bamboo_lisp_ext_init(Interp *interp) {
+    bamboo_lisp_stream_meta.type = STREAM_TYPEID;
+    bamboo_lisp_stream_meta.free = &stream_free;
+    bamboo_lisp_stream_meta.gcmark = &stream_gcmark;
+
+    Interp_add_userfunc(interp, "stream?", &ext_is_stream);
+    Interp_add_userfunc(interp, "open-file", &ext_open_file);
+    Interp_add_userfunc(interp, "stream-close", &ext_stream_close);
+    Interp_add_userfunc(interp, "read-char", &ext_read_char);
+    Interp_add_userfunc(interp, "read-integer", &ext_read_integer);
+    Interp_add_userfunc(interp, "read-number", &ext_read_number);
+    Interp_add_userfunc(interp, "read-line", &ext_read_line);
+    Interp_add_userfunc(interp, "lines", &ext_lines);
+    Interp_add_userfunc(interp, "write-char", &ext_write_char);
+    Interp_add_userfunc(interp, "write-obj", &ext_write_obj);
+    
+    return 1;
+}
\ No newline at end of file