;;; 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"
         "<!doctype html><title>lumbda</title><h1>feedback is all you need</h1><p>portable HTTP in Scheme.</p>"))
      ((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)
