-
Notifications
You must be signed in to change notification settings - Fork 2
/
nrepl.scm
64 lines (56 loc) · 2.17 KB
/
nrepl.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(import srfi-18 ;; threads
(chicken repl) ;; for ##sys#repl-print-hook when compiled
(only (chicken tcp) tcp-listen tcp-accept tcp-read-timeout))
(define nrepl-prompt (make-parameter (lambda () (display "#;> "))))
(define (nrepl-loop #!key
(eval eval)
(read read)
(print print)
;; repl-print-hook is nice because it limits printout size
(writeln (lambda (x) (##sys#repl-print-hook x (current-output-port)))))
(define (print-repl-prompt)
((nrepl-prompt))
(flush-output))
;; stolen from Chicken Core's eval.scm
(define (write-results . xs)
(cond ((null? xs)
(print "; no values\n"))
((and (null? (cdr xs))
(eq? (void) (car xs))) ;; <-- don't print #<unspecified>
(newline))
(else
(for-each writeln xs)
(when (pair? (cdr xs))
(print "; " (length xs) " values\n")))))
(let loop ()
(handle-exceptions root-exn
#f ;; <-- returns from repl-prompt
(print-repl-prompt)
(handle-exceptions exn
(begin (print-error-message exn (current-error-port))
(print-call-chain (current-error-port) 4) ;; remove 4 internal traces
(loop))
(let ([sexp (read)])
(unless (eof-object? sexp)
(call-with-values (lambda () (eval sexp))
write-results)
(loop)))))))
;; blocking repl, spawns new threads on incomming connections
(define (nrepl port #!key
(spawn (lambda ()
(thread-start!
(lambda ()
(print ";; nrepl on " (argv))
(nrepl-loop)))
#t))
(host "127.0.0.1")
(backlog 100))
(define socket (tcp-listen port backlog host))
(let loop ()
(let-values (((in out) (tcp-accept socket))) ;; <-- blocks
(parameterize ((tcp-read-timeout #f)
(current-input-port in)
(current-output-port out)
(current-error-port out))
(if (spawn)
(loop))))))