(module repl mzscheme (require (lib "servlet.ss" "web-server")) (provide interface-version timeout start) (define interface-version 'v1) (define timeout 20) ; start : request -> response (define (start initial-request) (define-values (read-pipe-input read-pipe-output) (make-pipe)) (define-values (print-pipe-input print-pipe-output) (make-pipe)) (define (get-print) (let loop ((acc (list))) (if (char-ready? print-pipe-input) (loop (cons (read-char print-pipe-input) acc)) (list->string (reverse acc))))) (define th (thread (lambda () (parameterize ([current-input-port read-pipe-input] [current-output-port print-pipe-output] [current-error-port print-pipe-output]) (read-eval-print-loop))))) (let* ((bindings (request-bindings (send/forward (lambda (k-url) (make-response/full 200 "Okay" (current-seconds) #"text/html" (list) (list "

Scheme REPL

" )))))) (i (and (exists-binding? 'i bindings) (extract-binding/single 'i bindings)))) (cond (i (write-string i print-pipe-output) (newline print-pipe-output) (write-string i read-pipe-output) (newline read-pipe-output) (make-response/full 200 "Okay" (current-seconds) #"text/plain" (list) (list))) ((exists-binding? 's bindings) (break-thread th) (make-response/full 200 "Okay" (current-seconds) #"text/plain" (list) (list))) (else (make-response/full 200 "Okay" (current-seconds) #"text/plain" (list) (list (begin (sleep 1) (get-print)))))))))