russell@unturf.com
346b873247
Adds a parallel build of all three Lumbda implementations to WASM, a
single-page playground at www/playground/, and a verified test suite.
Tiers
- Python: Pyodide (CPython-in-WASM) hosting lumbda.py
- C: Emscripten build of c/ (tree-walker + bytecode VM; jit.c
stubbed, gc.c uses its existing no-Boehm fallback)
- Asm: hand-written asm/lumbda.wat — parallel impl to asm/lumbda.s.
Reader, eval (lambda/define/if/cond/let/and/or/quote/set!),
recursion across mutated top-level env, bump allocator with
memory.grow, 24 primitives. ~1200 lines of raw WAT.
SPA (wasm/app/, deployed to www/playground/)
- CodeMirror 6 editor (Scheme highlighting) on left, output on right
- Radios: 4 demos (Mandelbrot, Fib+Ack, Sieve, self-interp meta-eval)
x 4 tiers (Python | C | Asm | All three)
- All-three mode renders the three tier outputs side by side with
per-tier elapsed timing
Tests (38 verified assertions)
- 20 unit (Node): per-tier module loads, eval smoke
- 8 integration (Node): each demo on c+asm WASM byte-matches the
canonical native Python run
- 10 functional (Playwright headless Chromium): page mounts, every
demo runs on every tier, all-three renders
Makefile
- Root targets: wasm-build, wasm-test, wasm-test-fn, wasm-serve,
wasm-deploy, wasm-clean
- wasm/Makefile orchestrates the three tier builds; deploy copies
dist/ into www/playground/
Asm tier notes
- WAT linear symbol intern + linear env lookup is MOAD-0001 at scale;
documented in the asm/lumbda.wat header and in the SPA footer. The
demos hit ~30 globals so the linear walks are cheap enough.
- Bump allocator never frees (matches asm/lumbda.s heap discipline);
memory.grow expands by 1 MB chunks. Browser tab tears down at unload.
Toolchain (developer prerequisites)
- Emscripten 6.0.0 via emsdk at ~/git/emsdk
- wabt 1.0.36 at ~/git/wabt
- Playwright for functional tests (symlinked from ~/git/agnt)
385 lines
13 KiB
Text
385 lines
13 KiB
Text
;;; stdlib.lsp — standard library for lumbda
|
|
;;; Load with: (load "stdlib.lsp")
|
|
;;; Automatically loaded by the interpreter if found next to lumbda.py.
|
|
|
|
;;;; ── Syntax-rules versions of core macros ────────────────────────────────
|
|
|
|
(define-syntax my-let
|
|
(syntax-rules ()
|
|
((my-let ((var val) ...) body ...)
|
|
((lambda (var ...) body ...) val ...))))
|
|
|
|
(define-syntax my-let*
|
|
(syntax-rules ()
|
|
((my-let* () body ...)
|
|
(begin body ...))
|
|
((my-let* ((var val) rest ...) body ...)
|
|
(let ((var val)) (my-let* (rest ...) body ...)))))
|
|
|
|
(define-syntax my-and
|
|
(syntax-rules ()
|
|
((my-and) #t)
|
|
((my-and e) e)
|
|
((my-and e1 e2 ...)
|
|
(if e1 (my-and e2 ...) #f))))
|
|
|
|
(define-syntax my-or
|
|
(syntax-rules ()
|
|
((my-or) #f)
|
|
((my-or e) e)
|
|
((my-or e1 e2 ...)
|
|
(let ((t e1))
|
|
(if t t (my-or e2 ...))))))
|
|
|
|
(define-syntax my-cond
|
|
(syntax-rules (else =>)
|
|
((my-cond (else e ...)) (begin e ...))
|
|
((my-cond (test => f) rest ...)
|
|
(let ((t test)) (if t (f t) (my-cond rest ...))))
|
|
((my-cond (test e ...) rest ...)
|
|
(if test (begin e ...) (my-cond rest ...)))
|
|
((my-cond) (void))))
|
|
|
|
(define-syntax my-case
|
|
(syntax-rules (else)
|
|
((my-case key (else e ...)) (begin e ...))
|
|
((my-case key ((datum ...) e ...) rest ...)
|
|
(if (memv key '(datum ...))
|
|
(begin e ...)
|
|
(my-case key rest ...)))
|
|
((my-case key) (void))))
|
|
|
|
(define-syntax my-when
|
|
(syntax-rules ()
|
|
((my-when test body ...)
|
|
(if test (begin body ...) (void)))))
|
|
|
|
(define-syntax my-unless
|
|
(syntax-rules ()
|
|
((my-unless test body ...)
|
|
(if test (void) (begin body ...)))))
|
|
|
|
(define-syntax my-do
|
|
(syntax-rules ()
|
|
((my-do ((var init step ...) ...)
|
|
(test result ...)
|
|
body ...)
|
|
(let loop ((var init) ...)
|
|
(if test
|
|
(begin result ...)
|
|
(begin body ...
|
|
(loop (if (null? '(step ...)) var (car '(step ...))) ...)))))))
|
|
|
|
;;;; ── Pattern-matched swap ────────────────────────────────────────────────
|
|
|
|
(define-syntax swap!
|
|
(syntax-rules ()
|
|
((swap! a b)
|
|
(let ((tmp a))
|
|
(set! a b)
|
|
(set! b tmp)))))
|
|
|
|
;;;; ── fluid-let ──────────────────────────────────────────────────────────
|
|
|
|
(define-syntax fluid-let
|
|
(syntax-rules ()
|
|
((fluid-let ((var val) ...) body ...)
|
|
(let ((old-var var) ...)
|
|
(set! var val) ...
|
|
(let ((result (begin body ...)))
|
|
(set! var old-var) ...
|
|
result)))))
|
|
|
|
;;;; ── receive (SRFI-8) ───────────────────────────────────────────────────
|
|
|
|
(define-syntax receive
|
|
(syntax-rules ()
|
|
((receive formals expression body ...)
|
|
(call-with-values (lambda () expression)
|
|
(lambda formals body ...)))))
|
|
|
|
;;;; ── begin0 ────────────────────────────────────────────────────────────
|
|
|
|
(define-syntax begin0
|
|
(syntax-rules ()
|
|
((begin0 first rest ...)
|
|
(let ((result first))
|
|
rest ...
|
|
result))))
|
|
|
|
;;;; ── while / until ──────────────────────────────────────────────────────
|
|
|
|
(define-syntax while
|
|
(syntax-rules ()
|
|
((while test body ...)
|
|
(let loop ()
|
|
(when test body ... (loop))))))
|
|
|
|
(define-syntax until
|
|
(syntax-rules ()
|
|
((until test body ...)
|
|
(let loop ()
|
|
(unless test body ... (loop))))))
|
|
|
|
;;;; ── dotimes / dolist ───────────────────────────────────────────────────
|
|
|
|
(define-syntax dotimes
|
|
(syntax-rules ()
|
|
((dotimes (var n result ...) body ...)
|
|
(let loop ((var 0))
|
|
(if (= var n)
|
|
(begin result ...)
|
|
(begin body ... (loop (+ var 1))))))))
|
|
|
|
(define-syntax dolist
|
|
(syntax-rules ()
|
|
((dolist (var lst result ...) body ...)
|
|
(begin
|
|
(for-each (lambda (var) body ...) lst)
|
|
result ...))))
|
|
|
|
;;;; ── push! / pop! ───────────────────────────────────────────────────────
|
|
|
|
(define-syntax push!
|
|
(syntax-rules ()
|
|
((push! val lst)
|
|
(set! lst (cons val lst)))))
|
|
|
|
(define-syntax pop!
|
|
(syntax-rules ()
|
|
((pop! lst)
|
|
(let ((top (car lst)))
|
|
(set! lst (cdr lst))
|
|
top))))
|
|
|
|
;;;; ── and-let* (SRFI-2) ─────────────────────────────────────────────────
|
|
|
|
(define-syntax and-let*
|
|
(syntax-rules ()
|
|
((and-let* () body ...) (begin body ...))
|
|
((and-let* ((var expr) rest ...) body ...)
|
|
(let ((var expr))
|
|
(if var (and-let* (rest ...) body ...) #f)))
|
|
((and-let* ((expr) rest ...) body ...)
|
|
(if expr (and-let* (rest ...) body ...) #f))))
|
|
|
|
;;;; ── string utilities ───────────────────────────────────────────────────
|
|
|
|
(define (string-repeat s n)
|
|
(apply string-append (map (lambda (_) s) (iota n))))
|
|
|
|
(define (string-pad-left s len ch)
|
|
(let ((pad (- len (string-length s))))
|
|
(if (<= pad 0) s
|
|
(string-append (make-string pad ch) s))))
|
|
|
|
(define (string-pad-right s len ch)
|
|
(let ((pad (- len (string-length s))))
|
|
(if (<= pad 0) s
|
|
(string-append s (make-string pad ch)))))
|
|
|
|
(define (string->chars s) (string->list s))
|
|
(define (chars->string cs) (list->string cs))
|
|
|
|
;;;; ── list utilities ─────────────────────────────────────────────────────
|
|
|
|
(define (list-update! lst i val)
|
|
(list-set! lst i val)
|
|
lst)
|
|
|
|
(define (enumerate lst)
|
|
(map list (iota (length lst)) lst))
|
|
|
|
(define (transpose lsts)
|
|
(apply map list lsts))
|
|
|
|
(define (interleave lst sep)
|
|
(if (or (null? lst) (null? (cdr lst)))
|
|
lst
|
|
(cons (car lst) (cons sep (interleave (cdr lst) sep)))))
|
|
|
|
(define (chunks lst n)
|
|
(if (null? lst)
|
|
'()
|
|
(cons (take lst (min n (length lst)))
|
|
(chunks (drop lst n) n))))
|
|
|
|
(define (repeat-list x n)
|
|
(map (lambda (_) x) (iota n)))
|
|
|
|
(define (zip-with f . lsts)
|
|
(apply map f lsts))
|
|
|
|
(define (sum lst) (fold-left + 0 lst))
|
|
(define (product lst) (fold-left * 1 lst))
|
|
(define (maximum lst) (fold-left max (car lst) (cdr lst)))
|
|
(define (minimum lst) (fold-left min (car lst) (cdr lst)))
|
|
(define (average lst) (/ (sum lst) (length lst)))
|
|
|
|
;;;; ── numeric utilities ──────────────────────────────────────────────────
|
|
|
|
(define (clamp x lo hi) (max lo (min hi x)))
|
|
(define (between? x lo hi) (and (>= x lo) (<= x hi)))
|
|
|
|
(define (factorial n)
|
|
(let loop ((i n) (acc 1))
|
|
(if (<= i 1) acc (loop (- i 1) (* acc i)))))
|
|
|
|
(define (fib n)
|
|
(let loop ((a 0) (b 1) (i 0))
|
|
(if (= i n) a (loop b (+ a b) (+ i 1)))))
|
|
|
|
(define (prime? n)
|
|
(if (< n 2) #f
|
|
(let loop ((i 2))
|
|
(cond ((> (* i i) n) #t)
|
|
((= (remainder n i) 0) #f)
|
|
(else (loop (+ i 1)))))))
|
|
|
|
(define (primes-up-to n)
|
|
(filter prime? (range 2 (+ n 1))))
|
|
|
|
;;;; ── I/O utilities ──────────────────────────────────────────────────────
|
|
|
|
(define (println . args)
|
|
(for-each (lambda (x) (display x) (display " ")) args)
|
|
(newline))
|
|
|
|
(define (print-table rows)
|
|
(for-each (lambda (row)
|
|
(for-each (lambda (cell) (display cell) (display "\t")) row)
|
|
(newline))
|
|
rows))
|
|
|
|
(define (with-output-string thunk)
|
|
(with-output-to-string thunk))
|
|
|
|
;;;; ── association-list utilities ─────────────────────────────────────────
|
|
|
|
(define (alist-get key alist . default)
|
|
(let ((pair (assoc key alist)))
|
|
(if pair (cdr pair)
|
|
(if (null? default) #f (car default)))))
|
|
|
|
(define (alist-set key val alist)
|
|
(cons (cons key val)
|
|
(filter (lambda (p) (not (equal? (car p) key))) alist)))
|
|
|
|
(define (alist-remove key alist)
|
|
(filter (lambda (p) (not (equal? (car p) key))) alist))
|
|
|
|
(define (alist-keys alist) (map car alist))
|
|
(define (alist-values alist) (map cdr alist))
|
|
|
|
;;;; ── hash-table utilities ───────────────────────────────────────────────
|
|
|
|
(define (hash-table-map h f)
|
|
(let ((result (make-hash-table)))
|
|
(hash-table-walk h (lambda (k v) (hash-table-set! result k (f v))))
|
|
result))
|
|
|
|
(define (hash-table-filter h pred)
|
|
(let ((result (make-hash-table)))
|
|
(hash-table-walk h (lambda (k v) (when (pred k v) (hash-table-set! result k v))))
|
|
result))
|
|
|
|
(define (hash-table-from-lists keys vals)
|
|
(let ((h (make-hash-table)))
|
|
(for-each (lambda (k v) (hash-table-set! h k v)) keys vals)
|
|
h))
|
|
|
|
;;;; ── tree utilities ─────────────────────────────────────────────────────
|
|
|
|
(define (tree-map f tree)
|
|
(if (pair? tree)
|
|
(cons (tree-map f (car tree)) (tree-map f (cdr tree)))
|
|
(f tree)))
|
|
|
|
(define (tree-fold f init tree)
|
|
(if (pair? tree)
|
|
(tree-fold f (tree-fold f init (car tree)) (cdr tree))
|
|
(f init tree)))
|
|
|
|
(define (tree-member? x tree)
|
|
(cond ((null? tree) #f)
|
|
((equal? x tree) #t)
|
|
((pair? tree) (or (tree-member? x (car tree))
|
|
(tree-member? x (cdr tree))))
|
|
(else #f)))
|
|
|
|
;;;; ── simple object system ───────────────────────────────────────────────
|
|
;;; (make-object methods-alist) → an object
|
|
;;; (send obj 'method arg...) → dispatch
|
|
|
|
(define (make-object methods)
|
|
(lambda (msg . args)
|
|
(let ((m (assoc msg methods)))
|
|
(if m
|
|
(apply (cdr m) args)
|
|
(error "unknown method" msg)))))
|
|
|
|
(define (send obj msg . args)
|
|
(apply obj msg args))
|
|
|
|
;;;; ── coroutine via call/cc ───────────────────────────────────────────────
|
|
|
|
(define (make-generator thunk)
|
|
(let ((k #f) (done #f))
|
|
(lambda ()
|
|
(if done 'done
|
|
(call/cc
|
|
(lambda (return)
|
|
(if k
|
|
(k return)
|
|
(begin
|
|
(thunk (lambda (val)
|
|
(call/cc (lambda (next)
|
|
(set! k next)
|
|
(return val)))))
|
|
(set! done #t)
|
|
(return 'done)))))))))
|
|
|
|
;;; ─── SRFI-64 lightweight test framework ─────────────────────────────────────
|
|
|
|
(define *test-pass* 0)
|
|
(define *test-fail* 0)
|
|
(define *test-group* "")
|
|
(define *test-verbose* #f)
|
|
|
|
(define (test-begin name)
|
|
(set! *test-group* name)
|
|
(set! *test-pass* 0)
|
|
(set! *test-fail* 0)
|
|
(display (string-append "--- " name " ---\n")))
|
|
|
|
(define (test-end)
|
|
(display (string-append *test-group* ": "
|
|
(number->string *test-pass*) " passed, "
|
|
(number->string *test-fail*) " failed\n"))
|
|
(= *test-fail* 0))
|
|
|
|
(define (test-assert msg val)
|
|
(if val
|
|
(begin (set! *test-pass* (+ *test-pass* 1))
|
|
(when *test-verbose* (display (string-append " OK " msg "\n"))))
|
|
(begin (set! *test-fail* (+ *test-fail* 1))
|
|
(display (string-append " FAIL " msg "\n")))))
|
|
|
|
(define-macro (test-equal msg expected expr)
|
|
(let ((r (gensym)) (e (gensym)))
|
|
`(let ((,r ,expr) (,e ,expected))
|
|
(if (equal? ,r ,e)
|
|
(begin (set! *test-pass* (+ *test-pass* 1))
|
|
(when *test-verbose* (display (string-append " OK " ,msg "\n"))))
|
|
(begin (set! *test-fail* (+ *test-fail* 1))
|
|
(display (string-append " FAIL " ,msg ": got " (write-to-string ,r)
|
|
" expected " (write-to-string ,e) "\n")))))))
|
|
|
|
(define-macro (test-error msg expr)
|
|
(let ((ok (gensym)))
|
|
`(let ((,ok (guard (e (#t #t)) ,expr #f)))
|
|
(if ,ok
|
|
(begin (set! *test-pass* (+ *test-pass* 1))
|
|
(when *test-verbose* (display (string-append " OK " ,msg " (error)\n"))))
|
|
(begin (set! *test-fail* (+ *test-fail* 1))
|
|
(display (string-append " FAIL " ,msg " (expected error)\n")))))))
|