;;; 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))