lexi-lambda · April 21, 2019 09:44 · Apr 21, 2019
diff --git a/check-foods.rkt b/check-foods.rkt
@@ -0,0 +1,22 @@
+#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)))
diff --git a/define-cross-phase.rkt b/define-cross-phase.rkt
@@ -0,0 +1,57 @@
+#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]))
diff --git a/foods.rkt b/foods.rkt
@@ -0,0 +1,14 @@
+#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))
No results found