Remove superseded item1 abort prototype notes

Message

The abort/interrupt op is now implemented via the sliced-eval task machinery (commit 2edb78d); the prototype patch/notes are no longer a resume point.

Changed

 notes/item1-abort-prototype.patch     | 192 ----------------------------------------------------------------------------------------------------------------------------------------------------------
 notes/item1-test-server-prototype.sgl | 110 ----------------------------------------------------------------------------------------
 2 files changed, 302 deletions(-)

Diff

notes/item1-abort-prototype.patchdeleted

@@ -1,192 +0,0 @@

−1

diff --git a/src/sigil/nrepl.sgl b/src/sigil/nrepl.sgl

−2

index 4e475ec..981844f 100644

−3

--- a/src/sigil/nrepl.sgl

−4

+++ b/src/sigil/nrepl.sgl

−5

@@ -24,6 +24,7 @@

−6

(sigil inspect)

−7

(sigil error)

−8

(sigil diagnostic)

−9

+ (sigil async)

−10

(sigil repl) ; Provides: make-prompt, make-debug-prompt, format-srcloc,

−11

; format-proc-name, format-backtrace-str, format-frame-str,

−12

; debug-help-text, parse-debug-command, string->int,

−13

@@ -76,11 +77,11 @@

−14

;; DATA STRUCTURES

−15

;; ============================================================

−16

−17

- ;; Server state: (vector 'nrepl-server socket port sessions)

−18

+ ;; Server state: (vector 'nrepl-server socket port sessions clients tasks)

−19

;; sessions is an alist of (session-id . session-state)

−20

−21

(define (make-nrepl-server socket port)

−22

- (vector 'nrepl-server socket port '() '()))

−23

+ (vector 'nrepl-server socket port '() '() '()))

−24

−25

(define (nrepl-server? obj)

−26

(and (vector? obj)

−27

@@ -105,6 +106,28 @@

−28

(define (nrepl-clients-set! server clients)

−29

(vector-set! server 4 clients))

−30

−31

+ (define (nrepl-tasks server)

−32

+ (vector-ref server 5))

−33

+

−34

+ (define (nrepl-tasks-set! server tasks)

−35

+ (vector-set! server 5 tasks))

−36

+

−37

+ ;; Eval task: (vector 'nrepl-eval-task client request-id thunk k response done? aborted?)

−38

+ (define (make-eval-task client id thunk)

−39

+ (vector 'nrepl-eval-task client id thunk #f #f #f #f))

−40

+

−41

+ (define (eval-task-client task) (vector-ref task 1))

−42

+ (define (eval-task-id task) (vector-ref task 2))

−43

+ (define (eval-task-thunk task) (vector-ref task 3))

−44

+ (define (eval-task-k task) (vector-ref task 4))

−45

+ (define (eval-task-k-set! task k) (vector-set! task 4 k))

−46

+ (define (eval-task-response task) (vector-ref task 5))

−47

+ (define (eval-task-response-set! task response) (vector-set! task 5 response))

−48

+ (define (eval-task-done? task) (vector-ref task 6))

−49

+ (define (eval-task-done-set! task done?) (vector-set! task 6 done?))

−50

+ (define (eval-task-aborted? task) (vector-ref task 7))

−51

+ (define (eval-task-aborted-set! task aborted?) (vector-set! task 7 aborted?))

−52

+

−53

     ;; Client connection: (vector 'nrepl-client socket buffer session-id module debug-mode? debug-error debug-trace debug-frame)

−54

;; debug-mode?: #t when client is in debug mode after an error

−55

;; debug-error: the error message string when in debug mode

−56

@@ -233,6 +256,8 @@

−57

;; Dispatch on operation

−58

(case op

−59

((eval) (handle-eval client id args))

−60

+ ((abort interrupt) (make-error-response* client id "server-required"

−61

+ "abort requests must be handled by an nREPL server"))

−62

((complete) (handle-complete client id args))

−63

((doc) (handle-doc client id args))

−64

((describe) (handle-describe client id args))

−65

@@ -394,6 +419,101 @@

−66

(format "~s" value))))))))))

−67

result))))))

−68

−69

+ (define (make-eval-thunk client id args)

−70

+ (lambda () (handle-eval client id args)))

−71

+

−72

+ (define (enqueue-eval-task! server client id args)

−73

+ (let ((task (make-eval-task client id (make-eval-thunk client id args))))

−74

+ (nrepl-tasks-set! server (append (nrepl-tasks server) (list task)))

−75

+ #f))

−76

+

−77

+ (define (find-task-by-id server target-id)

−78

+ (let loop ((tasks (nrepl-tasks server)))

−79

+ (cond

−80

+ ((null? tasks) #f)

−81

+ ((string=? (eval-task-id (car tasks)) target-id) (car tasks))

−82

+ (else (loop (cdr tasks))))))

−83

+

−84

+ (define (handle-abort server client id args)

−85

+ (let ((target-id (get-arg args ':target-id #f)))

−86

+ (if (not target-id)

−87

+ (make-error-response* client id "missing-target-id" "No :target-id provided")

−88

+ (let ((task (find-task-by-id server target-id)))

−89

+ (if task

−90

+ (begin

−91

+ (eval-task-aborted-set! task #t)

−92

+ (eval-task-k-set! task #f)

−93

+ (eval-task-response-set! task

−94

+ (make-error-response* (eval-task-client task) (eval-task-id task)

−95

+ "interrupted" "Evaluation interrupted"))

−96

+ (eval-task-done-set! task #t)

−97

+ (make-response* client id 'ok ':aborted target-id))

−98

+ (make-error-response* client id "not-found"

−99

+ (format "No running eval for request id ~a" target-id)))))))

−100

+

−101

+ (define (nrepl-handle-request* server client request)

−102

+ (if (not (and (pair? request) (eq? (car request) 'request)))

−103

+ (make-error-response "unknown" "invalid-request" "Expected (request ...)")

−104

+ (let* ((args (cdr request))

−105

+ (id (get-arg args ':id "unknown"))

−106

+ (op (get-arg args ':op #f))

−107

+ (module-name (get-arg args ':module #f)))

−108

+ (when (and module-name (string? module-name) (not (string=? module-name "")))

−109

+ (let ((mod (find-module (read-expr module-name))))

−110

+ (when mod

−111

+ (client-module-set! client mod))))

−112

+ (case op

−113

+ ((eval) (enqueue-eval-task! server client id args))

−114

+ ((abort interrupt) (handle-abort server client id args))

−115

+ (else (nrepl-handle-request client request))))))

−116

+

−117

+ (define (run-eval-task-slice! task)

−118

+ (when (and (not (eval-task-done? task))

−119

+ (not (eval-task-aborted? task)))

−120

+ (let ((saved-module (current-module))

−121

+ (result #f))

−122

+ (set-current-module! (client-module (eval-task-client task)))

−123

+ (set-vm-async-prompt-tag! async-prompt-tag)

−124

+ (set-vm-yield-requested! #t)

−125

+ (set! result

−126

+ (call-with-prompt

−127

+ async-prompt-tag

−128

+ (lambda (k op-type arg1 arg2)

−129

+ (eval-task-k-set! task k)

−130

+ 'yielded)

−131

+ (lambda ()

−132

+ (let ((k (eval-task-k task)))

−133

+ (if k

−134

+ (begin

−135

+ (eval-task-k-set! task #f)

−136

+ (k #t))

−137

+ ((eval-task-thunk task)))))))

−138

+ (set-vm-yield-requested! #f)

−139

+ (set-current-module! saved-module)

−140

+ (when (not (eq? result 'yielded))

−141

+ (eval-task-response-set! task result)

−142

+ (eval-task-done-set! task #t)))))

−143

+

−144

+ (define (send-eval-task-response! task)

−145

+ (let ((response (eval-task-response task))

−146

+ (client (eval-task-client task)))

−147

+ (when response

−148

+ (socket-write (client-socket client)

−149

+ (encode-message response)))))

−150

+

−151

+ (define (process-eval-tasks server)

−152

+ (let loop ((tasks (nrepl-tasks server))

−153

+ (remaining '()))

−154

+ (if (null? tasks)

−155

+ (nrepl-tasks-set! server (reverse remaining))

−156

+ (let ((task (car tasks)))

−157

+ (run-eval-task-slice! task)

−158

+ (if (eval-task-done? task)

−159

+ (begin

−160

+ (send-eval-task-response! task)

−161

+ (loop (cdr tasks) remaining))

−162

+ (loop (cdr tasks) (cons task remaining)))))))

−163

+

−164

;; complete - return completions for a prefix

−165

;; Includes both value bindings and syntax/macro bindings

−166

(define (handle-complete client id args)

−167

@@ -550,7 +670,9 @@

−168

;; Accept new connections

−169

(accept-pending-connections server)

−170

;; Process data from existing clients

−171

- (process-client-data server)))

−172

+ (process-client-data server)

−173

+ ;; Run one cooperative slice for each pending eval task.

−174

+ (process-eval-tasks server)))

−175

−176

;; Accept any pending connections

−177

(define (accept-pending-connections server)

−178

@@ -608,10 +730,11 @@

−179

(remaining (cdr result)))

−180

(client-buffer-set! client remaining)

−181

;; Handle the request

−182

- (let ((response (nrepl-handle-request client message)))

−183

+ (let ((response (nrepl-handle-request* server client message)))

−184

;; Send response

−185

- (socket-write (client-socket client)

−186

- (encode-message response)))

−187

+ (when response

−188

+ (socket-write (client-socket client)

−189

+ (encode-message response))))

−190

;; Check for more messages

−191

(process-client-messages server client)))))

−192

notes/item1-test-server-prototype.sgldeleted

@@ -1,110 +0,0 @@

−1

(import (sigil test)

−2

(sigil socket)

−3

(sigil io)

−4

(sigil math)

−5

(sigil string)

−6

(sigil nrepl))

−7

−8

(define *test-port* 57888)

−9

−10

(define (encode-test-message sexp)

−11

(let* ((str (format "~s" sexp))

−12

(msg-bytes (string->utf8 str))

−13

(len (bytevector-length msg-bytes))

−14

(prefix (make-bytevector 4)))

−15

(bytevector-u8-set! prefix 0 (quotient len 16777216))

−16

(bytevector-u8-set! prefix 1 (quotient (remainder len 16777216) 65536))

−17

(bytevector-u8-set! prefix 2 (quotient (remainder len 65536) 256))

−18

(bytevector-u8-set! prefix 3 (remainder len 256))

−19

(bytevector-append prefix msg-bytes)))

−20

−21

(define (send-request sock request)

−22

(socket-write sock (encode-test-message request)))

−23

−24

(define (read-at-least sock n acc attempts)

−25

(cond

−26

((<= attempts 0) #f)

−27

((>= (bytevector-length acc) n) acc)

−28

((socket-ready? sock 20)

−29

(let ((data (socket-read-bytevector sock)))

−30

(if (and data (not (eof-object? data)) (> (bytevector-length data) 0))

−31

(read-at-least sock n (bytevector-append acc data) attempts)

−32

(read-at-least sock n acc (- attempts 1)))))

−33

(else (read-at-least sock n acc (- attempts 1)))))

−34

−35

(define (read-response sock)

−36

(let ((header (read-at-least sock 4 (make-bytevector 0) 100)))

−37

(if header

−38

(let* ((b0 (bytevector-u8-ref header 0))

−39

(b1 (bytevector-u8-ref header 1))

−40

(b2 (bytevector-u8-ref header 2))

−41

(b3 (bytevector-u8-ref header 3))

−42

(len (+ (* b0 16777216) (* b1 65536) (* b2 256) b3))

−43

(needed (+ 4 len))

−44

(full (read-at-least sock needed header 100)))

−45

(and full

−46

(read-expr (utf8->string (bytevector-copy full 4 needed)))))

−47

#f)))

−48

−49

(define (response-ref resp key default)

−50

(let loop ((rest (if (and (pair? resp) (eq? (car resp) 'response))

−51

(cdr resp)

−52

'())))

−53

(cond

−54

((null? rest) default)

−55

((null? (cdr rest)) default)

−56

((eq? (car rest) key) (cadr rest))

−57

(else (loop (cddr rest))))))

−58

−59

(define (pump server n)

−60

(when (> n 0)

−61

(nrepl-process-pending server)

−62

(pump server (- n 1))))

−63

−64

(define (with-server thunk)

−65

(let ((server (nrepl-start *test-port*)))

−66

(dynamic-wind

−67

(lambda () #t)

−68

(lambda () (thunk server))

−69

(lambda () (nrepl-stop server)))))

−70

−71

(test-group "nrepl server eval"

−72

(test "eval round-trips through a loopback server"

−73

(with-server

−74

(lambda (server)

−75

(let ((sock (tcp-connect "127.0.0.1" *test-port*)))

−76

(send-request sock '(request :id "eval-ok" :op eval :code "(+ 1 2)"))

−77

(pump server 20)

−78

(let ((resp (read-response sock)))

−79

(assert-eq (response-ref resp ':status #f) 'ok)

−80

(assert-equal (response-ref resp ':value #f) "3"))

−81

(socket-close sock))))))

−82

−83

(test-group "nrepl abort"

−84

(test "runaway eval can be aborted from a second connection and the session survives"

−85

(with-server

−86

(lambda (server)

−87

(let ((eval-sock (tcp-connect "127.0.0.1" *test-port*))

−88

(abort-sock #f))

−89

(send-request eval-sock

−90

'(request :id "runaway" :op eval :code "(let loop () (loop))"))

−91

(pump server 5)

−92

(set! abort-sock (tcp-connect "127.0.0.1" *test-port*))

−93

(send-request abort-sock

−94

'(request :id "abort-runaway" :op abort :target-id "runaway"))

−95

(pump server 20)

−96

(let ((abort-resp (read-response abort-sock))

−97

(eval-resp (read-response eval-sock)))

−98

(assert-eq (response-ref abort-resp ':status #f) 'ok)

−99

(assert-eq (response-ref eval-resp ':status #f) 'error)

−100

(assert-equal (response-ref eval-resp ':code #f) "interrupted"))

−101

(send-request eval-sock

−102

'(request :id "after-abort" :op eval :code "(+ 20 22)"))

−103

(pump server 20)

−104

(let ((after-resp (read-response eval-sock)))

−105

(assert-eq (response-ref after-resp ':status #f) 'ok)

−106

(assert-equal (response-ref after-resp ':value #f) "42"))

−107

(socket-close eval-sock)

−108

(socket-close abort-sock))))))

−109

−110

(run-tests)