russell@unturf.com
f7352b51b0
Historical internal name "uncommonlisp" retired in favor of the
public name "lumbda" ahead of lumbda.com going live. Scope of
this commit:
Source files renamed:
uncommonlisp.py -> lumbda.py
asm/uncommonlisp.s -> asm/lumbda.s
c/uncommonlisp.h -> c/lumbda.h
whitepaper/uncommonlisp-whitepaper -> whitepaper/lumbda-whitepaper (.rst + .pdf)
Binaries renamed (tracked ones; c/ was always gitignored):
asm/uncommonlisp, asm/uncommonlisp-gc, asm/uncommonlisp.o,
asm/uncommonlisp-gc.o -> asm/lumbda(-gc)(.o)
c/.gitignore -> ignores lumbda
Internal string updates (sed pass ordered longest-first):
asm/uncommonlisp -> asm/lumbda
c/uncommonlisp -> c/lumbda
uncommonlisp.py -> lumbda.py
UNCOMMONLISP_BIN -> LUMBDA_BIN (asm/test.sh env var)
"uncommonlisp> " -> "lumbda> " (asm REPL prompt baked into binary)
UNCOMMONLISP -> LUMBDA (macros, comments)
uncommonlisp -> lumbda (prose)
Binary portal magic updated:
"ULPORTAL" -> "LUMBDAB1" # "Lumbda Binary v1"
Old portal files are not backward-compatible — this is a deliberate
break since it's the rename moment. S-expression portals already
carry their own ";; lumbda-portal v1" header and remain cleanly
versioned.
WHITEPAPER.pdf / WHITEPAPER.rst symlinks repointed to the renamed
files. Makefile's whitepaper target targets lumbda-whitepaper.pdf.
Not changed (intentional, separate phases):
- Filesystem directory /home/fox/git/uncommonlisp itself
(fox renames locally and the gitlab repo URL in a follow-up)
- tests.py hardcoded cwd=/home/fox/git/uncommonlisp
(matches the current on-disk location; will flip when the
directory rename ships)
- Git history (immutable; old commits still say uncommonlisp,
which is correct — that's what they were)
Verified:
137 asm no-GC + 137 asm GC + 571 Python + 83 C + 189 shared
functional tests all pass under the new names.
bench-gc-http (2000 req): all 4 cells behave as expected
(cells 1/2 flat, 3 leaks, 4 bounded at 1 chunk).
Python REPL, C REPL, asm REPL all start cleanly.
110 lines
4.2 KiB
Text
110 lines
4.2 KiB
Text
;;; rpc-server.lsp — S-expression RPC with a whitelisted dispatch table.
|
|
;;;
|
|
;;; Wire protocol: each connection carries ONE request S-expression and
|
|
;;; returns ONE response S-expression. Bytes on the wire are Scheme source;
|
|
;;; the parser on each side is already the right tool.
|
|
;;;
|
|
;;; Runs byte-identically in Python, C, and asm:
|
|
;;; python3 lumbda.py --fast examples/rpc-server.lsp
|
|
;;; ./c/lumbda examples/rpc-server.lsp
|
|
;;; ./asm/lumbda < examples/rpc-server.lsp
|
|
;;;
|
|
;;; Request examples (send as plain text, one per connection):
|
|
;;; (ping) -> pong
|
|
;;; (add 1 2 3) -> 6
|
|
;;; (mul 6 7) -> 42
|
|
;;; (fib 30) -> 832040
|
|
;;; (echo (1 2 3)) -> (1 2 3)
|
|
;;; (nope whatever) -> (error "unknown op: nope")
|
|
;;;
|
|
;;; The server never calls (eval) on client input. Only whitelisted ops
|
|
;;; run. This is the safe RPC pattern. For full remote eval see
|
|
;;; examples/repl-server.lsp.
|
|
|
|
(define *port* 9080)
|
|
(define *max-requests* 100000)
|
|
|
|
;;; ── Whitelisted handlers ────────────────────────────────────
|
|
|
|
(define (do-ping args) 'pong)
|
|
(define (do-echo args) (if (pair? args) (car args) '()))
|
|
(define (do-add args)
|
|
(if (null? args) 0
|
|
(+ (car args) (do-add (cdr args)))))
|
|
(define (do-mul args)
|
|
(if (null? args) 1
|
|
(* (car args) (do-mul (cdr args)))))
|
|
(define (do-fib args)
|
|
(let loop ((a 0) (b 1) (i 0) (n (car args)))
|
|
(if (= i n) a (loop b (+ a b) (+ i 1) n))))
|
|
|
|
(define (dispatch op args)
|
|
(cond
|
|
((eqv? op 'ping) (do-ping args))
|
|
((eqv? op 'echo) (do-echo args))
|
|
((eqv? op 'add) (do-add args))
|
|
((eqv? op 'mul) (do-mul args))
|
|
((eqv? op 'fib) (do-fib args))
|
|
(else (list 'error (string-append "unknown op: " (symbol->string op))))))
|
|
|
|
;;; ── Wire handler ────────────────────────────────────────────
|
|
|
|
(define (handle-request raw)
|
|
;; raw is a string like "(add 1 2)". Parse, dispatch, return a string.
|
|
(let ((form (read-from-string raw)))
|
|
(if (pair? form)
|
|
(let ((op (car form)) (args (cdr form)))
|
|
(response->string (dispatch op args)))
|
|
(response->string (list 'error "malformed request")))))
|
|
|
|
;; Defined leaf-first so closures never capture a forward reference —
|
|
;; which the asm impl resolves at define time via env-chain pointer
|
|
;; and therefore cannot see a name bound later.
|
|
|
|
(define (atom->string v)
|
|
(cond
|
|
((number? v) (number->string v))
|
|
((symbol? v) (symbol->string v))
|
|
((null? v) "()")
|
|
((pair? v) (string-append "(" (list->string v) ")"))
|
|
((string? v) (string-append "\"" v "\""))
|
|
(else "#<unknown>")))
|
|
|
|
(define (list->string lst)
|
|
(cond
|
|
((null? lst) "")
|
|
((null? (cdr lst)) (atom->string (car lst)))
|
|
(else (string-append (atom->string (car lst)) " " (list->string (cdr lst))))))
|
|
|
|
(define (response->string v)
|
|
;; Custom readable serializer — avoids open-output-string so this runs
|
|
;; unchanged in asm (which lacks mutable string ports). Covers the
|
|
;; response shapes our dispatch table can return.
|
|
(cond
|
|
((number? v) (string-append (number->string v) "\n"))
|
|
((symbol? v) (string-append (symbol->string v) "\n"))
|
|
((null? v) "()\n")
|
|
((pair? v) (string-append "(" (list->string v) ")\n"))
|
|
((string? v) (string-append "\"" v "\"\n"))
|
|
(else "#<unknown>\n")))
|
|
|
|
;;; ── Main loop ───────────────────────────────────────────────
|
|
|
|
(define server (tcp-listen *port*))
|
|
|
|
(define (server-loop n snap)
|
|
(if (>= n *max-requests*)
|
|
(begin (display "request cap reached, exiting\n") (tcp-close server))
|
|
(begin
|
|
(let ((client (tcp-accept server)))
|
|
(let ((req (tcp-recv client 4096)))
|
|
(if (and req (> (string-length req) 0))
|
|
(tcp-send client (handle-request req))
|
|
#f))
|
|
(tcp-close client))
|
|
(heap-restore snap)
|
|
(server-loop (+ n 1) snap))))
|
|
|
|
(display "rpc-server on :") (display *port*)
|
|
(display " (whitelisted: ping echo add mul fib)") (newline)
|
|
(server-loop 0 (heap-snapshot))
|