;;; http-server.lsp — portable HTTP/1.0 server in pure Scheme
;;;
;;; Runs identically in Python, C, and asm. The only primitives used are
;;; the six socket builtins + display/string-append/substring.
;;;
;;; python3 lumbda.py --fast examples/http-server.lsp
;;; ./c/lumbda examples/http-server.lsp
;;; ./asm/lumbda < examples/http-server.lsp
;;;
;;; Default port 8080. First-line dispatch: GET / → greeting page.
;;; GET /bench → 1 KB body for throughput benchmarks.
;;; Other paths → 404.
(define *port* 8080)
(define *crlf* "\r\n")
(define *crlf-crlf* "\r\n\r\n")
;;; Request ceiling. Acts as a belt-and-suspenders cap under the
;;; heap-snapshot loop below. The snapshot mechanism (asm only) rewinds
;;; per-request allocations so memory stays O(1) regardless of ceiling.
;;; On Python + C the GC handles this; the cap still bounds accidentally
;;; runaway demo servers.
(define *max-requests* 1000000)
;;; heap-snapshot / heap-restore are available in all three impls.
;;; On asm they rewind the bump allocator (recycling per-request
;;; allocations in O(1) memory). On Python + C they are no-ops
;;; because those runtimes already have a real GC.
;;; ── HTTP helpers ─────────────────────────────────────────────
(define (http-response status ctype body)
(string-append
"HTTP/1.0 " status *crlf*
"Content-Type: " ctype *crlf*
"Content-Length: " (number->string (string-length body)) *crlf*
"Connection: close" *crlf-crlf*
body))
;; Compare via char->integer so we don't need char=? (asm lacks it).
(define SPACE 32)
(define (char-at s i) (char->integer (string-ref s i)))
(define (first-token s)
(let ((len (string-length s)))
(let loop ((i 0))
(cond
((= i len) s)
((= (char-at s i) SPACE) (substring s 0 i))
(else (loop (+ i 1)))))))
(define (second-token s)
(let ((len (string-length s)))
(let loop1 ((i 0))
(cond
((= i len) "")
((= (char-at s i) SPACE)
(let loop2 ((j (+ i 1)))
(cond
((= j len) (substring s (+ i 1) len))
((= (char-at s j) SPACE) (substring s (+ i 1) j))
(else (loop2 (+ j 1))))))
(else (loop1 (+ i 1)))))))
;;; ── Request handler ─────────────────────────────────────────
(define *bench-body*
;; ~1 KB payload so clients have something to measure throughput on.
(let loop ((s "") (i 0))
(if (= i 32) s
(loop (string-append s "0123456789abcdef0123456789abcdef") (+ i 1)))))
(define (handle-request req)
(let ((path (second-token req)))
(cond
((string=? path "/")
(http-response "200 OK" "text/html"
"lumbdafeedback is all you need
portable HTTP in Scheme.
"))
((string=? path "/bench")
(http-response "200 OK" "text/plain" *bench-body*))
((string=? path "/hello")
(http-response "200 OK" "text/plain" "hello world\n"))
(else
(http-response "404 Not Found" "text/plain"
(string-append "not found: " path "\n"))))))
;;; ── Main loop ───────────────────────────────────────────────
;;; Top-level `server` and `server-loop`. The snapshot `snap` is
;;; passed down as an explicit arg — this avoids any issue with
;;; closures captured before/after the snapshot.
(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))
;; Rewind per-request allocations on asm; no-op elsewhere.
(heap-restore snap)
(server-loop (+ n 1) snap))))
(define (serve)
(display "lumbda http server on :") (display *port*)
(display " (max ") (display *max-requests*) (display " requests)") (newline)
(server-loop 0 (heap-snapshot)))
(serve)