tcprepl.scm

;; Charles Jackson
;; tcprepl - a repl to be connected to by netcat or telnet
;; Connect with $ nc localhost 7000

(##namespace ("tcprepl#"))
(##include "~~lib/gambit#.scm")
(##namespace ("" system-appname system-appversion exception->string
                 fix secondselapsed->string system-buildepoch system-builddatetime))

(define repl-server-port 7000)

(define server (open-tcp-server
                (list server-address: "*"
                      port-number: repl-server-port
                      reuse-address: #t)))

(define (ported-repl port name)
  (with-input-from-port port
    (lambda ()
      (with-output-to-port port
        (lambda () 
          (let loop ((depth 0))
            (with-exception-handler
             (lambda (exception)
               (display-exception exception)
               (if (and (os-exception? exception)
                        (= (os-exception-code exception)
                           -515899360))         ;broken pipe
                   (thread-terminate! (current-thread))
                   (loop (+ depth 1))))
             (lambda ()
               (display (string-append
                         name
                         (if (> depth 0)
                             (string-append (if (equal? name "") "" "-")
                                            (number->string depth))
                             "")
                         "> "))
               (force-output)
               (let ((input (read)))
                 (cond ;; This is where `,` debugging commands can be implemented
                  ((equal? input #!eof) (thread-terminate! (current-thread)))
                  (else (pretty-print (eval input)))))
               (loop depth)))))))))

(define (repl-server)
  (let loop ()
    (let* ((client (read server))     ;wait here for the client to connect
           (thread
            (make-thread
             (lambda ()
               (ported-repl client (with-exception-handler
                                    (lambda (e) "")
                                    (lambda () (system-appname))))
               (close-port client))
             'repl)))
      (thread-base-priority-set! thread 1)
      (thread-start! thread)
      (loop))))

(thread-start! (make-thread repl-server))

;; eof