Моей первоначальной мыслью для достижения этой цели было использование генераторов и yield. Но это была ошибка , которая была отчасти ошибочной из-за того, что питон злоупотреблял yield from.
В любом случае, хитрые волокна были большим вдохновением, и я адаптировал их к схеме Chez .
Вот пример кода сервера:
(define (handler request port)
(values 200 #f (http-get "https://httpbin.davecheney.com/ip")))
(untangle (lambda ()
(run-server "127.0.0.1" 8888)))
handler возвращает свой IP в соответствии со службой httpbin. Код выглядит синхронно с помощью call / cc, на самом деле call / 1cc.
untangle инициирует цикл обработки событий с лямбдой, передаваемой в качестве аргумента!
Вот определение run-server:
(define (run-server ip port handler)
(log 'info "HTTP server running at ~a:~a" ip port)
(let* ((sock (socket 'inet 'stream 'ipv4)))
(socket:setsockopt sock 1 2 1) ;; re-use address
(socket:bind sock (make-address ip port))
(socket:listen sock 1024)
(let loop ()
(let ((client (accept sock)))
(let ((port (fd->port client)))
(spawn (lambda () (run-once handler port)))
(loop))))))
Как видите, обратного вызова нет. Единственное, что несколько отличается от простого синхронного веб-сервера, - это процедура spawn, которая будет обрабатывать запрос в своей собственной сопрограмме. В частности accept является асинхронным.
run-once просто передаст запрос схемы на handler и примет 3 значения для построения ответа. Не очень интересно Часть, которая выглядит синхронной, но на самом деле асинхронной, находится на http-get выше.
Я только объясню, как работает accept, учитывая, что http-get требует ввода пользовательских двоичных портов, но достаточно сказать, что это то же самое поведение ...
(define (accept fd)
(let ((out (socket:%accept fd 0 0)))
(if (= out -1)
(let ((code (socket:errno)))
(if (= code EWOULDBLOCK)
(begin
(abort-to-prompt fd 'read)
(accept fd))
(error 'accept (socket:strerror code))))
out)))
Как вы можете видеть, она вызывает процедуру abort-to-prompt, которую мы могли бы просто вызвать pause, которая "остановит" сопрограмму и вызовет обработчик приглашения.
abort-to-prompt работает в сотрудничестве с call-with-prompt.
Поскольку схема chez не имеет подсказок, я эмулирую ее, используя два продолжения одного выстрела call/1cc
(define %prompt #f)
(define %abort (list 'abort))
(define (call-with-prompt thunk handler)
(call-with-values (lambda ()
(call/1cc
(lambda (k)
(set! %prompt k)
(thunk))))
(lambda out
(cond
((and (pair? out) (eq? (car out) %abort))
(apply handler (cdr out)))
(else (apply values out))))))
(define (abort-to-prompt . args)
(call/1cc
(lambda (k)
(let ((prompt %prompt))
(set! %prompt #f)
(apply prompt (cons %abort (cons k args)))))))
call-with-prompt будет инициировать продолжение set! global с именем %prompt, что означает, что для THUNK имеется единственное приглашение. Если аргументы продолжения OUT, вторая лямбда call-with-values, начинаются с уникального объекта %abort, это означает, что продолжение было достигнуто через abort-to-prompt. Он вызовет HANDLER с продолжением abort-to-prompt и любым аргументом, переданным параметру продолжения call-with-prompt, который является (apply handler (cons k (cdr out))).
abort-to-promp инициирует новое продолжение, чтобы иметь возможность вернуться после того, как код выполнит продолжение приглашения, сохраненное в %prompt.
call-with-prompt - это сердце цикла событий. Вот оно, в двух частях:
(define (exec epoll thunk waiting)
(call-with-prompt
thunk
(lambda (k fd mode) ;; k is abort-to-prompt continuation that
;; will allow to restart the coroutine
;; add fd to the correct epoll set
(case mode
((write) (epoll-wait-write epoll fd))
((read) (epoll-wait-read epoll fd))
(else (error 'untangle "mode not supported" mode)))
(scheme:hash-table-set! waiting fd (make-event k mode)))))
(define (event-loop-run-once epoll waiting)
;; execute every callback waiting in queue,
;; call the above exec procedure
(let loop ()
(unless (null? %queue)
;; XXX: This is done like that because, exec might spawn
;; new coroutine, so we need to cut %queue right now.
(let ((head (car %queue))
(tail (cdr %queue)))
(set! %queue tail)
(exec epoll head waiting)
(loop))))
;; wait for ONE event
(let ((fd (epoll-wait-one epoll (inf))
(let ((event (scheme:hash-table-ref waiting fd)))
;; the event is / will be processed, no need to keep around
(scheme:hash-table-delete! waiting fd)
(case (event-mode event)
((write) (epoll-ctl epoll 2 fd (make-epoll-event-out fd)))
((read) (epoll-ctl epoll 2 fd (make-epoll-event-in fd))))
;; here it will schedule the event continuation that is the
;; abort-to-prompt continuation that will be executed by the
;; next call the above event loop event-loop-run-once
(spawn (event-continuation event))))))
Я думаю, что это все.