Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#lang racket
(require racket/control)
(struct spwn (val p) #:prefab #:extra-name Spwn)
(define (fcontrol-at p v)
(fcontrol (spwn v p)))
(define (%-at p th handler)
(% (th) (λ (x k)
(match x
[(Spwn v p~) #:when (eqv? p p~)
(handler v k)]
[(Spwn v p~)
(let [(res (fcontrol-at p~ v))]
(%-at p (λ () (k res)) handler))]))))
(define (perform eff v)
(fcontrol-at eff v))
(define (new-effect) (make-continuation-prompt-tag))
(define ((call-with-shallow-handler eff vh effh) th)
(let* [(p (make-continuation-prompt-tag 'return))
(const (λ (x _) x))
(effh~ (λ (x k)
(fcontrol-at p (effh x k))))]
(%-at p (λ () (vh (%-at eff (λ () (th)) effh~))) const)))
; --------
(let* [(eff (new-effect))
(handle- (λ (effh th)
((call-with-shallow-handler eff
(λ (x) (+ x 3 ))
effh)
th)))]
(handle-
(λ (v k) (k (+ v 10000000)))
(λ () (handle-
(λ (v k) (k (+ v 10000)))
(λ ()
(+ (perform eff 11) (perform eff 13)))))))
@Nymphium
Copy link
Author

Nymphium commented Jan 7, 2020

(struct coroutine ([it #:mutable]) #:extra-name Coroutine)

(define Yield (new-effect))
(define (yield v)
  (perform Yield v))

(define (resume co v)
  ((call-with-shallow-handler Yield
                              (λ (x) x)
                              (λ (u k)
                                 (begin
                                   (set-coroutine-it! co k)
                                   u)))
   (λ () ((coroutine-it co) v))))

(let [(co (coroutine
           (λ (_)
              (begin
                (display "hello,")
                (displayln (yield '()))
                ))))]
  (begin
    (resume co '())
    (resume co "world")))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment