Finally committing the f-to-c examples of Sep 23, 2016

racket/syndicate/actor.rkt

@@ -1139,6 +1139,7 @@
 (module+ implementation-details
   (provide actor-behavior
            boot-actor
+           make-field
            (struct-out field-descriptor)
            (struct-out field-handle)
            (struct-out actor-state)

racket/syndicate/examples/actor/f-to-c.rkt

@@ -0,0 +1,56 @@
+#lang syndicate/actor
+;; After the Fahrenheit-to-Celsius converter example in "Fabrik - A
+;; Visual Programming Environment", Ingalls, Wallace, Chow, Ludolph
+;; and Doyle, OOPSLA 1988.
+
+;;---------------------------------------------------------------------------
+
+(struct versioned-value (value version write-id) #:prefab)
+
+(define (random-id)
+  (local-require racket/random sha)
+  (bytes->hex-string (crypto-random-bytes 16)))
+
+(define versioned-field-sentinel (cons #f #f))
+
+(define (make-versioned-field name initial-value)
+  (local-require (only-in (submod syndicate/actor implementation-details) make-field))
+  (define f (make-field name (versioned-value initial-value 0 "")))
+  (match-lambda*
+    [(list) (versioned-value-value (f))]
+    [(list (== versioned-field-sentinel eq?) 'get-field) f]
+    [(list new-value)
+     (f (versioned-value new-value (current-inexact-milliseconds) (random-id)))]
+    [(list new-value cause)
+     (define cause-f (versioned-field->field cause))
+     (match-define (versioned-value _ my-version my-write-id) (f))
+     (match-define (versioned-value _ cause-version cause-write-id) (cause-f))
+     (when (or (> cause-version my-version)
+               (and (= cause-version my-version) (string>? cause-write-id my-write-id)))
+       (f (versioned-value new-value cause-version cause-write-id)))]))
+
+(define (versioned-field->field vf) (vf versioned-field-sentinel 'get-field))
+
+(define-syntax-rule (versioned-field [id init] ...)
+  (begin (define id (make-versioned-field 'id init)) ...))
+
+;;---------------------------------------------------------------------------
+
+(struct temperature (unit value) #:prefab)
+(struct set-temperature (unit value) #:prefab)
+
+(spawn (versioned-field [C 0] [F 32])
+       (begin/dataflow
+         (F (exact->inexact (+ (* (C) 9/5) 32)) C)
+         (C (exact->inexact (* (- (F) 32) 5/9)) F))
+       (assert (temperature 'C (C)))
+       (assert (temperature 'F (F)))
+       (on (message (set-temperature 'C $v)) (C v))
+       (on (message (set-temperature 'F $v)) (F v)))
+
+(spawn (on (asserted (temperature $unit $value))
+           (printf "Temperature in ~a is ~a\n" unit value)))
+
+(spawn (on (asserted (observe (set-temperature _ _)))
+           (send! (set-temperature 'C 20))
+           (send! (set-temperature 'F 90))))

racket/syndicate/examples/actor/f-to-c2.rkt

@@ -0,0 +1,29 @@
+#lang syndicate/actor
+;; After the Fahrenheit-to-Celsius converter example in "Fabrik - A
+;; Visual Programming Environment", Ingalls, Wallace, Chow, Ludolph
+;; and Doyle, OOPSLA 1988.
+
+(struct temperature (unit value) #:prefab)
+(struct set-temperature (unit value) #:prefab)
+
+(spawn (field [temp 0])
+       (assert (temperature 'C (temp)))
+       (on (message (set-temperature 'C $new-temp))
+           (temp new-temp))
+       (on (asserted (temperature 'F $other-temp))
+           (temp (exact->inexact (* (- other-temp 32) 5/9)))))
+
+(spawn (field [temp 32])
+       (assert (temperature 'F (temp)))
+       (on (message (set-temperature 'F $new-temp))
+           (temp new-temp))
+       (on (asserted (temperature 'C $other-temp))
+           (temp (exact->inexact (+ (* other-temp 9/5) 32)))))
+
+(spawn (on (asserted (temperature $unit $value))
+           (printf "Temperature in ~a is ~a\n" unit value)))
+
+(spawn (on (asserted (observe (set-temperature _ _)))
+           ;; (send! (set-temperature 'C 20))
+           (send! (set-temperature 'F 90))
+           ))