diff --git a/c/eval.c b/c/eval.c index 1751cda..57dd3ad 100644 --- a/c/eval.c +++ b/c/eval.c @@ -1243,9 +1243,14 @@ Value leval(Value expr, Env *env) { } if (head == SYM_EVAL) { + /* Argument evaluates in the current env; result evaluates + * in the global env so a (define ...) inside an (eval ...) + * installs the binding where callers can see it. Matches + * Python's leval and asm's bi_eval. */ Value *a; int na = value_to_list(tail, &a); expr = leval(a[0], env); ul_free(a); + env = env->global ? env->global : env; continue; } diff --git a/examples/portal-http-client.lsp b/examples/portal-http-client.lsp new file mode 100644 index 0000000..1645636 --- /dev/null +++ b/examples/portal-http-client.lsp @@ -0,0 +1,99 @@ +;;; portal-http-client.lsp — fetch an S-expression portal over HTTP, +;;; evaluate each form to materialize the bindings locally. +;;; +;;; This is the concrete demo of "portal over HTTP" from the whitepaper: +;;; one machine serves its state, another pulls it down and resumes. +;;; Because the portal format is Scheme source, the client is a few +;;; lines of string-munging plus (read-from-string) + (eval). +;;; +;;; Usage (server must be running first — see portal-http-server.lsp): +;;; python3 uncommonlisp.py --fast examples/portal-http-client.lsp +;;; ./c/uncommonlisp examples/portal-http-client.lsp +;;; ./asm/uncommonlisp < examples/portal-http-client.lsp + +(define *host* "127.0.0.1") +(define *port* 9085) +(define *request* "GET /portal HTTP/1.0\r\nHost: 127.0.0.1\r\nConnection: close\r\n\r\n") + +;;; ── Strip HTTP headers: body starts after the first "\r\n\r\n". ── +;;; Portable implementation — walks bytes, tracks a 4-state matcher. + +(define (find-crlfcrlf s) + (let ((len (string-length s))) + (let loop ((i 0)) + (if (> (+ i 4) len) + -1 + (if (and (= (char->integer (string-ref s i)) 13) + (= (char->integer (string-ref s (+ i 1))) 10) + (= (char->integer (string-ref s (+ i 2))) 13) + (= (char->integer (string-ref s (+ i 3))) 10)) + (+ i 4) + (loop (+ i 1))))))) + +(define (body-of resp) + (let ((start (find-crlfcrlf resp))) + (if (< start 0) + "" + (substring resp start (string-length resp))))) + +;;; ── Fetch and evaluate ────────────────────────────────────── +;;; +;;; Read up to 64 KB of response in one tcp-recv. For a small +;;; portal body this is always one packet on localhost. +;;; +;;; Then split the body by line, read+eval each non-empty, +;;; non-comment line. Top-level define forms land in the global env. + +(define (first-n-chars s n) + (if (> (string-length s) n) (substring s 0 n) s)) + +(define (fetch-portal) + (let ((sock (tcp-connect *host* *port*))) + (if sock + (begin + (tcp-send sock *request*) + (let ((resp (tcp-recv sock 65536))) + (tcp-close sock) + (body-of resp))) + ""))) + +(define (line-at s start) + ;; Extract line starting at index `start` (exclusive of \n). + ;; Returns the substring up to the next \n (or end). + (let ((len (string-length s))) + (let loop ((i start)) + (cond + ((= i len) (substring s start len)) + ((= (char->integer (string-ref s i)) 10) (substring s start i)) + (else (loop (+ i 1))))))) + +(define (eval-all-lines s) + (let ((len (string-length s))) + (let loop ((i 0) (cnt 0)) + (if (>= i len) cnt + (let ((line (line-at s i))) + (let ((next (+ i (string-length line) 1))) + (cond + ((= (string-length line) 0) + (loop next cnt)) + ((= (char->integer (string-ref line 0)) 59) ; ; = comment + (loop next cnt)) + (else + (eval (read-from-string line)) + (loop next (+ cnt 1)))))))))) + +;;; ── Go ────────────────────────────────────────────────────── + +(define portal-body (fetch-portal)) +(display "fetched ") (display (string-length portal-body)) (display " bytes") (newline) +(display "first line: ") (display (line-at portal-body 0)) (newline) + +(define evaluated (eval-all-lines portal-body)) +(display "evaluated ") (display evaluated) (display " forms") (newline) + +;; Now the remote bindings are live locally. Use them: +(display "counter = ") (display counter) (newline) +(display "my-int = ") (display my-int) (newline) +(display "my-fib = ") (display my-fib) (newline) +(display "my-list has ") (display (length my-list)) (display " items") (newline) +(display "my-str = ") (display my-str) (newline) diff --git a/examples/portal-http-server.lsp b/examples/portal-http-server.lsp new file mode 100644 index 0000000..9b8cf7b --- /dev/null +++ b/examples/portal-http-server.lsp @@ -0,0 +1,120 @@ +;;; portal-http-server.lsp — serve S-expression portal bytes over HTTP. +;;; +;;; The server holds some state (bindings). On GET /portal it serializes +;;; those bindings as an S-expression portal (just (define ...) forms) +;;; and returns them as the HTTP body. A client can (tcp-connect) + +;;; read, strip the HTTP headers, and evaluate the body — which is +;;; literally Scheme source. +;;; +;;; This closes the loop: continuations / state across machines via +;;; sockets, using the language itself as the wire format. +;;; +;;; Runs byte-identically in Python, C, and asm: +;;; python3 uncommonlisp.py --fast examples/portal-http-server.lsp +;;; ./c/uncommonlisp examples/portal-http-server.lsp +;;; ./asm/uncommonlisp < examples/portal-http-server.lsp +;;; +;;; Default port 9085. + +(define *port* 9085) +(define *max-requests* 100000) + +;;; ── Some state worth migrating ─────────────────────────────── +;;; +;;; This is the "work" the server has done that a client might want +;;; to pick up and resume. fib(30) and some lists. + +(define counter 0) +(define my-int 42) +(define my-list (list 1 2 3 4 5 6 7 8 9 10)) +(define my-str "portal was here") +(define my-fib + (let loop ((a 0) (b 1) (i 0)) + (if (= i 30) a (loop b (+ a b) (+ i 1))))) + +;;; ── S-expression portal serializer ─────────────────────────── +;;; Same pattern as rpc-server's response builder; no ports needed. + +(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 "#"))) + +(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 (portal-body) + ;; Produce the S-expression portal as a single string. + (string-append + ";; uncommonlisp portable portal\n" + "(define counter " (number->string counter) ")\n" + "(define my-int " (number->string my-int) ")\n" + "(define my-list '(" (list->string my-list) "))\n" + "(define my-str \"" my-str "\")\n" + "(define my-fib " (number->string my-fib) ")\n")) + +;;; ── HTTP plumbing ──────────────────────────────────────────── + +(define (http-response status ctype body) + (string-append + "HTTP/1.0 " status "\r\n" + "Content-Type: " ctype "\r\n" + "Content-Length: " (number->string (string-length body)) "\r\n" + "Connection: close\r\n\r\n" + body)) + +;; Get second space-separated token from the request line (the path). +(define (path-of req) + (let ((len (string-length req))) + (let loop1 ((i 0)) + (cond + ((= i len) "") + ((= (char->integer (string-ref req i)) 32) + (let loop2 ((j (+ i 1))) + (cond + ((= j len) (substring req (+ i 1) len)) + ((= (char->integer (string-ref req j)) 32) (substring req (+ i 1) j)) + (else (loop2 (+ j 1)))))) + (else (loop1 (+ i 1))))))) + +(define (handle req) + (let ((path (path-of req))) + (cond + ((string=? path "/portal") + (http-response "200 OK" "application/scheme" (portal-body))) + ((string=? path "/") + (http-response "200 OK" "text/html" + "portal-http

uncommonlisp portal-http

GET /portal returns the S-expression portal.

")) + (else + (http-response "404 Not Found" "text/plain" + (string-append "not found: " path "\n")))))) + +;;; ── Main loop ──────────────────────────────────────────────── + +(define server (tcp-listen *port*)) + +(define (serve-loop n snap) + ;; counter is mutated per request, so the portal body changes with use. + (set! counter (+ counter 1)) + (if (>= n *max-requests*) + (begin (display "request cap reached\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 req)) + #f)) + (tcp-close client)) + (heap-restore snap) + (serve-loop (+ n 1) snap)))) + +(display "portal-http on :") (display *port*) +(display " — GET /portal for the S-exp portal") (newline) +(serve-loop 0 (heap-snapshot)) diff --git a/uncommonlisp.py b/uncommonlisp.py index 20a1850..3102cd9 100644 --- a/uncommonlisp.py +++ b/uncommonlisp.py @@ -933,7 +933,12 @@ def leval(expr, env): raise LispErr(f'apply: not callable: {show(proc)}') if head is S('eval'): - a = _L(tail); expr = leval(a[0], env); continue + # Evaluate the argument in the current env (so the caller can + # pass a local expression), but evaluate the RESULT in the + # global env. This matches asm's bi_eval and lets portal + # resume — (eval (read-from-string ...)) — install bindings + # that outlive the evaluating function. + a = _L(tail); expr = leval(a[0], env); env = env.g; continue if head is S('error'): a = _L(tail)