Welcome to the CHICKEN Scheme pasting service

;;; I like to use synchronous REPLs for my game loops:
;;; (let game-loop () (process-repl) (process-events) (draw-scene) (game-loop))
;;; this ensures that your repl doesn't do any opengl calls during (draw-scene), for example.

;;; It uses call/cc to acheive yielding in the `read`.
(use tcp)

(define (make-yielding-input-port port yield!)
  (let ([reader (lambda ()
                  (let loop ()
                    (if (char-ready? port)
                        (read-char port)
                        (begin
                          (call/cc (lambda (k) (yield! (lambda () (k #f)))))
                          (loop)))))] )
    (make-input-port reader
                     (lambda () (char-ready? port))
                     (lambda () (close-input-port port)))))


(define (repl-loop in-port out-port close!)
  
  (define (repl-prompt op)
    (display "@> " op)
    (flush-output op))

  (let loop ()
    (handle-exceptions root-exn
      (close!) ;; <-- close/remove repl connection on error (broken pipe)
      
      (repl-prompt out-port)
      (handle-exceptions exn
        (begin (print-error-message exn out-port)
               (print-call-chain out-port 4)
               (loop))
        ;; reading from in-port will probably yield:
        (let ([sexp (read in-port)])
          ;; eof, exit repl loop
          (if (eof-object? sexp)
              (close!) ;; I don't think this ever happens, actually
              (with-output-to-port out-port
                (lambda ()
                  (with-error-output-to-port
                   out-port
                   (lambda ()
                     (let ([result (eval sexp)])
                       (if (eq? (void) result)
                           (void) ;; don't print unspecified's
                           (begin
                             (write result out-port)
                             (display "\n" out-port))))))))))
        (loop)))))

(define (make-tcp-repl port)
  (define socket (tcp-listen port))
  (define connections '())

  (lambda (#!optional (command #:run))
    (cond
     ((eq? command #:status) connections)
     ((eq? command #:socket) socket)
     ((eq? command #:close)  "not yet implemented")
     ((eq? command #:run)
      (handle-exceptions exn
        ;; we might see things like "cannot compute remote address -
        ;; Transport endpoint is not connected" here:
        (begin (print-error-message exn)) ;; TODO: print to all repl outports too?
        (when (tcp-accept-ready? socket)
          (tcp-read-timeout #f)
          (let-values (((in out) (tcp-accept socket)))
            (let-values (((local-adr remote-adr) (tcp-addresses in))
                         ((local-port remote-port) (tcp-port-numbers in)))
              (print "accepting from " remote-adr ":" remote-port)
              (let* ((con (list #f remote-adr remote-port in out)))
                (set! (car con)
                      (lambda ()
                        (call/cc
                         (lambda (return)
                           (repl-loop (make-yielding-input-port
                                       in
                                       ;; yield! procedure:
                                       (lambda (k) ;; <-- call k to resume
                                         (set! (car con) k)
                                         (return #f)))
                                      out
                                      ;; close! procedure:
                                      (lambda ()
                                        (set! connections
                                              (remove (lambda (con%) (equal? con con%)) connections))))))))
                (set! connections (cons con connections)))))))
      ;; process all active connections:
      (for-each
       (lambda (con)
         (let ((proc (car con)))
           (proc)))
       connections))
     (else (error "unknown command (try none #:status #:socket #:close)" command)))))