lumbda/wasm/c/lumbda_wasm_entry.c

/* lumbda_wasm_entry.c — Emscripten entry points for the C tier.
 *
 * The JS loader provides Module.print / Module.printErr callbacks that
 * Emscripten routes stdout/stderr through, so output capture happens on
 * the JS side. We only expose:
 *
 *   lumbda_wasm_init()           — set up symbols + env + stdlib
 *   lumbda_wasm_eval(src)        — eval src, last value printed if non-void
 *   lumbda_wasm_free_result(p)   — free a string returned to JS
 *
 * The env is module-global so successive eval calls preserve defines.
 */
#include "lumbda.h"
#include "jit.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

static Env *g_wasm_env = NULL;

static const char *MINI_STDLIB =
    "(define (caar p) (car (car p)))\n"
    "(define (cadr p) (car (cdr p)))\n"
    "(define (cdar p) (cdr (car p)))\n"
    "(define (cddr p) (cdr (cdr p)))\n"
    "(define (caddr p) (car (cdr (cdr p))))\n"
    "(define (cadddr p) (car (cdr (cdr (cdr p)))))\n"
    "(define (list . xs) xs)\n"
    "(define (not x) (if x #f #t))\n"
    "(define (map f xs) (if (null? xs) '() (cons (f (car xs)) (map f (cdr xs)))))\n"
    "(define (length xs) (if (null? xs) 0 (+ 1 (length (cdr xs)))))\n"
    "(define (reverse xs) (if (null? xs) '() (append (reverse (cdr xs)) (list (car xs)))))\n"
    "(define (append a b) (if (null? a) b (cons (car a) (append (cdr a) b))))\n"
    "(define (zero? n) (= n 0))\n"
    "(define (positive? n) (> n 0))\n"
    "(define (negative? n) (< n 0))\n"
    "(define (abs n) (if (< n 0) (- 0 n) n))\n";

void lumbda_wasm_init(void) {
    if (g_wasm_env) return;
    init_symbols();
    g_wasm_env = make_global_env();

    /* Load PRELUDE (built into eval/builtins via make_global_env). */
    int count = 0;
    Value *exprs = read_all(PRELUDE, &count, false);
    for (int i = 0; i < count; i++) leval(exprs[i], g_wasm_env);
    ul_free(exprs);

    /* Load a small stdlib subset embedded above. Full stdlib.lsp is too
     * large to embed cleanly; demos only need the listed primitives. */
    count = 0;
    exprs = read_all(MINI_STDLIB, &count, false);
    ErrorContext ctx_local;
    ctx_local.call_stack_depth = 0;
    ctx_local.error_obj = VAL_NIL;
    ctx_local.source_line = 0;
    g_error_ctx = &ctx_local;
    if (setjmp(ctx_local.jmp) == 0) {
        for (int i = 0; i < count; i++) leval(exprs[i], g_wasm_env);
    }
    ul_free(exprs);
}

/* Eval src. Output during eval goes to stdout (captured by Module.print
 * on the JS side). The final non-void value's repr is appended to stdout
 * via printf("%s\n", ...).
 *
 * Returns NULL on success, or a malloc'd error message on failure. JS
 * frees via lumbda_wasm_free_result.
 */
char *lumbda_wasm_eval(const char *src) {
    if (!g_wasm_env) lumbda_wasm_init();

    ErrorContext ctx_local;
    ctx_local.call_stack_depth = 0;
    ctx_local.error_obj = VAL_NIL;
    ctx_local.source_line = 0;
    g_error_ctx = &ctx_local;

    if (setjmp(ctx_local.jmp) != 0) {
        const char *msg = ctx_local.message[0] ? ctx_local.message : "unknown error";
        size_t n = strlen(msg) + 16;
        char *err = (char *)malloc(n);
        snprintf(err, n, "error: %s", msg);
        return err;
    }

    int count = 0;
    Value *exprs = read_all(src, &count, false);
    Value last = VAL_VOID;
    for (int i = 0; i < count; i++) {
        last = leval(exprs[i], g_wasm_env);
    }
    ul_free(exprs);

    if (!IS_VOID(last)) {
        char *rep = show(last, false);
        printf("%s\n", rep);
        fflush(stdout);
        ul_free(rep);
    } else {
        fflush(stdout);
    }
    return NULL;
}

void lumbda_wasm_free_result(char *p) {
    if (p) free(p);
}