lumbda/c/main.c

/*
 * main.c — REPL, script mode, -e mode
 */
#include "lumbda.h"
#include "jit.h"

/* ═══════════════════════════════════════════════════════════════════════════
 * Find stdlib.lsp relative to the executable
 * ═══════════════════════════════════════════════════════════════════════════ */

static char *find_stdlib(const char *argv0) {
    /* Try relative to executable: ../stdlib.lsp */
    char path[4096];

    /* Try via /proc/self/exe on Linux */
    ssize_t n = readlink("/proc/self/exe", path, sizeof(path) - 1);
    if (n > 0) {
        path[n] = '\0';
        /* Go up one directory (from c/lumbda to lumbda/) */
        char *slash = strrchr(path, '/');
        if (slash) {
            *slash = '\0';
            slash = strrchr(path, '/');
            if (slash) {
                slash[1] = '\0';
                strcat(path, "stdlib.lsp");
                if (access(path, R_OK) == 0) return ul_strdup(path);
            }
        }
    }

    /* Try current directory */
    if (access("stdlib.lsp", R_OK) == 0) return ul_strdup("stdlib.lsp");

    /* Try relative to argv0 */
    if (argv0) {
        const char *slash = strrchr(argv0, '/');
        if (slash) {
            size_t dir_len = slash - argv0;
            snprintf(path, sizeof(path), "%.*s/../stdlib.lsp", (int)dir_len, argv0);
            if (access(path, R_OK) == 0) return ul_strdup(path);
        }
    }

    return NULL;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * REPL
 * ═══════════════════════════════════════════════════════════════════════════ */

static void repl(Env *env) {
    char *version_str = show(env_lookup(env, intern("*version*")), true);
    printf("lumbda %s (C) — (exit) to quit, (load \"file.lsp\") to load\n", version_str);
    ul_free(version_str);

    char buf[16384];
    buf[0] = '\0';
    size_t buf_len = 0;

    while (1) {
        printf(buf_len > 0 ? "   " : "λ> ");
        fflush(stdout);

        char line[4096];
        if (!fgets(line, sizeof(line), stdin)) {
            if (buf_len > 0) { buf[0] = '\0'; buf_len = 0; printf("\n"); continue; }
            printf("\n");
            break;
        }

        size_t line_len = strlen(line);
        if (buf_len + line_len >= sizeof(buf) - 1) {
            buf[0] = '\0'; buf_len = 0; continue;
        }
        memcpy(buf + buf_len, line, line_len);
        buf_len += line_len;
        buf[buf_len] = '\0';

        /* Check for balanced parens */
        int depth = 0;
        for (size_t i = 0; i < buf_len; i++) {
            if (buf[i] == '(') depth++;
            else if (buf[i] == ')') depth--;
        }
        if (depth > 0) continue;

        /* Try to parse */
        int count;
        Value *exprs;
        TRY(ctx) {
            exprs = read_all(buf, &count, false);
        } CATCH {
            if (depth > 0) continue;
            buf[0] = '\0'; buf_len = 0;
            continue;
        } ENDTRY;

        if (count == 0) { buf[0] = '\0'; buf_len = 0; continue; }

        for (int i = 0; i < count; i++) {
            TRY(ctx) {
                Value result = leval(exprs[i], env);
                if (!IS_VOID(result)) {
                    print_value(result, false, stdout);
                    printf("\n");
                }
            } CATCH {
                fprintf(stderr, "error: %s\n", ctx.message);
            } ENDTRY;
        }
        ul_free(exprs);
        buf[0] = '\0'; buf_len = 0;
    }
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Main
 * ═══════════════════════════════════════════════════════════════════════════ */

int main(int argc, char **argv) {
    int stack_anchor;
#ifdef USE_BOEHM_GC
    /* GC_INIT registers our stack base for conservative scan. Without it,
     * roots can be missed on some Linux configs.
     *
     * lumbda_gc_init registers a custom mark kind for NaN-boxed Value
     * buffers (see gc.c). Boehm's conservative scan treats NaN-boxed
     * Values as plain bit patterns & misses the embedded pointers, so
     * any allocation that carries Values (Pair, Env bindings, Vector
     * data[], CodeObj instrs[], ValueStack data[], etc.) routes through
     * lumbda_value_malloc / ul_malloc_values which tags the block with
     * our kind. Our mark proc then walks the words & pushes each
     * pointer-bearing tag's payload onto Boehm's mark stack.
     *
     * lumbda_gc_set_stack_base hands gc.c the top-of-stack so its
     * push_other_roots callback can scan the same range for on-stack
     * NaN-boxed Values that Boehm's pure conservative scan misses.
     */
    GC_INIT();
    lumbda_gc_init();
    lumbda_gc_set_stack_base(&stack_anchor);
#else
    (void)stack_anchor;
#endif
    init_symbols();
    Env *g = make_global_env();

    /* Load prelude */
    {
        int count;
        Value *exprs = read_all(PRELUDE, &count, false);
        for (int i = 0; i < count; i++) leval(exprs[i], g);
        ul_free(exprs);
    }

    /* Parse args */
    int argi = 1;
    /* Default stays tree-walker for now. Flipping to --fast as default
     * exposed a cumulative-state buffer overflow in the bytecode
     * compiler that only triggers across the full 189-test functional
     * suite, not in isolated scripts. Tracked as a TODO. For deeply
     * recursive workloads (e.g. ackermann(3,8)) pass --fast explicitly
     * or `ulimit -s unlimited` before invoking the tree-walker. */
    bool fast = false;
    bool help = false;
    bool version = false;
    bool jit = false;
    const char *eval_expr = NULL;

    while (argi < argc) {
        if (strcmp(argv[argi], "--jit") == 0 || strcmp(argv[argi], "-j") == 0) {
            jit = true; argi++;
        } else if (strcmp(argv[argi], "--fast") == 0 || strcmp(argv[argi], "-f") == 0) {
            fast = true; argi++;
        } else if (strcmp(argv[argi], "--help") == 0 || strcmp(argv[argi], "-h") == 0) {
            help = true; argi++;
        } else if (strcmp(argv[argi], "--version") == 0 || strcmp(argv[argi], "-v") == 0) {
            version = true; argi++;
        } else if (strcmp(argv[argi], "-e") == 0 && argi + 1 < argc) {
            eval_expr = argv[argi + 1]; argi += 2;
        } else {
            break;
        }
    }

    if (help) {
        printf("lumbda — a Scheme interpreter in C\n\n"
               "Usage: lumbda [options] [script.lsp] [args...]\n"
               "       lumbda -e '(+ 1 2)'\n"
               "       lumbda                    (interactive REPL)\n\n"
               "Options:\n"
               "  -e EXPR       evaluate expression and print result\n"
               "  -f, --fast    auto-compile all defines (bytecode VM;\n"
               "                required for deep recursion, e.g. ackermann(3,8))\n"
               "  -j, --jit     enable x86_64 JIT compiler for eligible functions\n"
               "  -h, --help    show this help\n"
               "  -v, --version show version\n\n"
               "Features: R7RS core, bytecode compiler, macros, syntax-rules,\n"
               "          modules, rationals, string ports, x86_64 JIT.\n");
        return 0;
    }

    if (version) {
        printf("lumbda 1.0.0 (C)\n");
        return 0;
    }

    if (fast) g_auto_compile = true;
    if (jit) g_jit_enabled = true;

    /* Load stdlib.lsp if it exists */
    char *stdlib_path = find_stdlib(argv[0]);
    if (stdlib_path) {
        TRY(ctx) {
            load_file(stdlib_path, g);
        } CATCH {
            /* Ignore stdlib load errors — it's optional */
        } ENDTRY;
        ul_free(stdlib_path);
    }

    /* -e mode */
    if (eval_expr) {
        TRY(ctx) {
            int count;
            Value *exprs = read_all(eval_expr, &count, false);
            for (int i = 0; i < count; i++) {
                Value result = leval(exprs[i], g);
                if (!IS_VOID(result)) {
                    print_value(result, false, stdout);
                    printf("\n");
                }
            }
            ul_free(exprs);
        } CATCH {
            fprintf(stderr, "error: %s\n", g_error_ctx ? g_error_ctx->message : "unknown");
            return 1;
        } ENDTRY;
        return 0;
    }

    /* Script mode */
    if (argi < argc) {
        const char *path = argv[argi];
        /* Set *argv* */
        int script_argc = argc - argi - 1;
        Value *script_argv = (Value *)ul_malloc(sizeof(Value) * script_argc);
        for (int i = 0; i < script_argc; i++) {
            script_argv[i] = make_string_from_cstr(argv[argi + 1 + i]);
        }
        env_define(g, intern("*argv*"), list_to_value(script_argv, script_argc));
        ul_free(script_argv);

        TRY(ctx) {
            load_file(path, g);
        } CATCH {
            fprintf(stderr, "error: %s\n", ctx.message);
            return 1;
        } ENDTRY;
        return 0;
    }

    /* REPL mode */
    ErrorContext root_ctx;
    root_ctx.call_stack_depth = 0;
    root_ctx.error_obj = VAL_NIL;
    root_ctx.source_line = 0;
    g_error_ctx = &root_ctx;
    if (setjmp(root_ctx.jmp) != 0) {
        fprintf(stderr, "fatal error: %s\n", root_ctx.message);
        return 1;
    }
    repl(g);
    return 0;
}