fcontrol.rkt

(require control/racket)

; (% (+ (fcontrol 3) (fcontrol 4))  (λ (x k) (k (* x x))))
; ~> ((λ (x k) (k (* x x))) 3 (λ (y) (+ y (fcontrol 4))))
; ~> ((λ (y) (+ y (fcontrol 4))) 9)
; ~> (+ 9 (fcontrol 4))
; ~> %の外側に出ちゃたあ(正しい)

(let [(p (make-continuation-prompt-tag))]
  (% (+ (fcontrol 3 #:tag p) (fcontrol 4 #:tag p))  (λ (x k) (k (* x x))) #:tag p))
; ~>* 25
; なぜ…

(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~) (%-at p (th) (fcontrol-at p~ v) handler)]))))

(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))]))))