New variations on f-to-c
This commit is contained in:
parent
0526364698
commit
fc0e900485
|
@ -0,0 +1,39 @@
|
|||
#lang syndicate
|
||||
;; 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 version) #:prefab)
|
||||
(struct set-temperature (unit value version) #:prefab)
|
||||
|
||||
(spawn #:name 'track-celsius
|
||||
(field [temp 0] [version 0])
|
||||
(assert (temperature 'C (temp) (version)))
|
||||
(on (message (set-temperature 'C $new-temp $v))
|
||||
(when (> v (version))
|
||||
(temp new-temp)
|
||||
(version v))))
|
||||
|
||||
(spawn #:name 'track-fahrenheit
|
||||
(field [temp 32] [version 0])
|
||||
(assert (temperature 'F (temp) (version)))
|
||||
(on (message (set-temperature 'F $new-temp $v))
|
||||
(when (> v (version))
|
||||
(temp new-temp)
|
||||
(version v))))
|
||||
|
||||
(spawn #:name 'convert-C-to-F
|
||||
(on (asserted (temperature 'C $other-temp $v))
|
||||
(send! (set-temperature 'F (+ (* other-temp 9/5) 32) v))))
|
||||
|
||||
(spawn #:name 'convert-F-to-C
|
||||
(on (asserted (temperature 'F $other-temp $v))
|
||||
(send! (set-temperature 'C (* (- other-temp 32) 5/9) v))))
|
||||
|
||||
(spawn (on (asserted (temperature $unit $value $v))
|
||||
(printf "Temperature in ~a at version ~a is ~a\n" unit v (exact->inexact value))))
|
||||
|
||||
(spawn (on (asserted (observe (set-temperature _ _ _)))
|
||||
(send! (set-temperature 'C 20 1))
|
||||
(send! (set-temperature 'F 90 2))
|
||||
))
|
|
@ -0,0 +1,38 @@
|
|||
#lang syndicate
|
||||
;; After the Fahrenheit-to-Celsius converter example in "Fabrik - A
|
||||
;; Visual Programming Environment", Ingalls, Wallace, Chow, Ludolph
|
||||
;; and Doyle, OOPSLA 1988.
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(define (make-idempotent-field name initial-value [=? equal?])
|
||||
(local-require (submod syndicate/actor implementation-details))
|
||||
(define f (make-field name initial-value))
|
||||
(match-lambda*
|
||||
[(list) (f)]
|
||||
[(list new-value)
|
||||
(unless (=? (field-ref (field-handle-desc f)) new-value)
|
||||
(f new-value))]))
|
||||
|
||||
(define-syntax-rule (idempotent-field [id init] ...)
|
||||
(begin (define id (make-idempotent-field 'id init)) ...))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(struct temperature (unit value) #:prefab)
|
||||
(struct set-temperature (unit value) #:prefab)
|
||||
|
||||
(spawn (idempotent-field [C 0] [F 32])
|
||||
(begin/dataflow (F (+ (* (C) 9/5) 32)))
|
||||
(begin/dataflow (C (* (- (F) 32) 5/9)))
|
||||
(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 (exact->inexact value))))
|
||||
|
||||
(spawn (on (asserted (observe (set-temperature _ _)))
|
||||
(send! (set-temperature 'C 20))
|
||||
(send! (set-temperature 'F 90))))
|
Loading…
Reference in New Issue