check-foods.rkt

#lang racket
(require syntax/parse/define "foods.rkt" (for-syntax "foods.rkt"))

(add-delicious-food! "pineapple")
(add-delicious-food! "sushi")
(add-delicious-food! "cheesecake")

(define-simple-macro (add-food-combinations! [fst:string ...]
                                             [snd:string ...])
  #:do [(for* ([fst-str (in-list (syntax->datum #'[fst ...]))]
               [snd-str (in-list (syntax->datum #'[snd ...]))])
          (add-delicious-food! (string-append fst-str " " snd-str)))]
  (void))

; should add “fried chicken,” “roasted chicken”, “fried potato,” and “roasted potato”
(add-food-combinations! ["fried" "roasted"] ["chicken" "potato"])

(command-line
  #:args [food-to-check]
  (if (delicious-food? food-to-check)
      (printf "~a is a delicious food.\n" food-to-check)
      (printf "~a is not delicious.\n" food-to-check)))

define-cross-phase.rkt

#lang racket

(require (for-syntax racket/syntax)
         syntax/parse/define)

(provide define/cross-phase)

(define-simple-macro (define/cross-phase x:id e:expr)
  #:with topic-mod-name (generate-temporary 'cross-phase-topic-key)
  (begin
    (module topic-mod-name '#%kernel
      (#%declare #:cross-phase-persistent)
      (#%provide topic)
      (define-values [topic] (gensym "cross-phase")))
    (require 'topic-mod-name)
    (define x (make-cross-phase topic (λ () e)))))

(define root-logger (current-logger))

(define (make-cross-phase topic thunk)
  (define receiver (make-log-receiver root-logger 'debug topic))
  (define chan (make-channel))
  (define executor (make-will-executor))

  (let ()
    (define canary (gensym 'canary))
    (will-register executor canary (λ (v) 'collected))
    (log-message root-logger 'debug topic ""
                 (vector-immutable canary chan) #f)
    (let loop ()
      (match (sync receiver)
        [(vector _ _ (vector _ (== chan eq?)) _)
         (void)]
        [_
         (loop)])))

  (define execute-evt (wrap-evt executor will-execute))
  (define result (let loop ([n 0])
                   (sleep)
                   (or (sync/timeout 0 chan execute-evt)
                       (begin
                         (collect-garbage (if (< n 3) 'minor 'major))
                         (loop (add1 n))))))

  (match result
    [(vector _ value)
     value]
    ['collected
     (define value (thunk))
     (thread
      (λ ()
        (let loop ()
          (match (sync receiver)
            [(vector _ _ (vector canary chan) _)
             (thread (λ () (channel-put chan (vector-immutable canary value))))
             (loop)]))))
     value]))

foods.rkt

#lang racket
(require "define-cross-phase.rkt")
(provide delicious-food? add-delicious-food!)

(define/cross-phase cross:set-member? set-member?)
(define/cross-phase cross:set-add! set-add!)

(define/cross-phase delicious-foods (mutable-set))

(define (delicious-food? food)
  (cross:set-member? delicious-foods food))

(define (add-delicious-food! new-food)
  (cross:set-add! delicious-foods new-food))