Héllo,
I've done some exploration regarding this topic; I think it might of
interest or it's very naive.
It goes like this:
``` scheme
(define (loop-run-forever)
(while #true
(call-with-prompt 'loop
loop-run-once
(lambda (cc callback) (callback cc)))))
```
`loop-run-once` does the `do-select` thing and call scheduled task. Then
we only need to wrap blocking calls inside `abort-to-prompt`, here an
example with `read`:
```
(define (read/ sock)
(abort-to-prompt 'loop (lambda (cc)
(loop-add-reader sock (lambda () (cc (read
sock)))))))
```
`loop-add-reader` is procedure that register a callback against `select`
to restart the computation where it was left it's equivalent to
`port-request-read` machinery.
I attached an example server, the client is vanilla imperative code.
Also, it doesn't implement exception propagation.
I don't understand the point of %8sync macro when all blocking calls can
be expressed directly in terms of abort-to-prompt.
HTH
(setlocale LC_ALL "")
(define sock (socket PF_INET SOCK_STREAM 0))
(connect sock AF_INET INADDR_LOOPBACK 12345)
(pk sock)
(write "héllo world" sock)
(write "you are free" sock)
(close sock)
(define-module (plain))
(use-modules (srfi srfi-9)) ;; records
(use-modules (srfi srfi-9 gnu)) ;; set-record-type-printer! and set-field
;;;
;;; plain records
;;;
;;
;; macro to quickly define records
;;
;;
;; Usage:
;;
;; (define-record-type <car> seats wheels)
;; (define smart (make-abc 2 4))
;; (car-seats smart) ;; => 2
;;
;; Mutation is not done in place, via set-field or set-fields eg.:
;;
;; (define smart-for-4 (set-field smart (seats) 4))
;;
(define-syntax define-record-type*
(lambda (x)
(define (%id-name name) (string->symbol (string-drop (string-drop-right
(symbol->string name) 1) 1)))
(define (id-name ctx name)
(datum->syntax ctx (%id-name (syntax->datum name))))
(define (id-append ctx . syms)
(datum->syntax ctx (apply symbol-append (map syntax->datum syms))))
(syntax-case x ()
((_ rname field ...)
(and (identifier? #'rname) (and-map identifier? #'(field ...)))
(with-syntax ((cons (id-append #'rname #'make- (id-name #'rname
#'rname)))
(pred (id-append #'rname (id-name #'rname #'rname) #'?))
((getter ...) (map (lambda (f)
(id-append f (id-name #'rname
#'rname) #'- f))
#'(field ...))))
#'(define-record-type rname
(cons field ...)
pred
(field getter)
...))))))
(export define-record-type*)
(re-export set-record-type-printer!)
(re-export set-field)
(use-modules (rnrs bytevectors))
(use-modules (ice-9 rdelim))
(define sock (socket PF_INET SOCK_STREAM 0))
(bind sock (make-socket-address AF_INET INADDR_ANY 12345))
(listen sock 128)
(define inbound (accept sock))
(define-public (string->scm string)
(call-with-input-string string
(lambda (port)
(read port))))
(define (read-message port)
(let next ((char (read-char port))
(out '()))
(if (eq? char #\0)
(list->string (reverse out))
(next (read-char port) (cons char out)))))
