-
Notifications
You must be signed in to change notification settings - Fork 3
/
reactive-macros.rkt
150 lines (141 loc) · 9.22 KB
/
reactive-macros.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
; macro definitions for reactive-thing%
#lang s-exp rosette
(require racket/gui/base)
(require "../core/wallingford.rkt")
(require "../applications/geothings.rkt")
(require "abstract-reactive-thing.rkt")
(require "reactive-constants.rkt")
(provide when while max-value min-value integral pull-sampling? interesting-time?
when-holder-test when-holder-body when-holder-id
linearized-when-holder-linearized-test linearized-when-holder-dt linearized-when-holder-epsilon
while-holder-test while-holder-body while-holder-id while-holder-interesting while-holder-pull?)
; Structs to hold whens and whiles -- the test and body are both thunks (anonymous lambdas).
; id is a unique symbol for that when or while
; For when, if the test is approximated as a piecewise linear function, use linearized-when-holder. In that case
; dt should be the interval size, and epsilon the tolerance for testing whether the time found by a linear approximation
; is close enough to the target time.
(struct when-holder (test body id) #:transparent)
(struct linearized-when-holder when-holder (linearized-test dt epsilon) #:transparent)
; for while-holder, pull? is #t if pull sampling should be used while this 'while' is active, and #f if not
(struct while-holder (test body id interesting pull?) #:transparent)
; interesting-time? will be rebound when evaluating a while -- it will be the value of the interesting-time function
; for that while at the current time. It is used for accumulating operators such as max-value.
(define interesting-time? (make-parameter #f))
; Definition of 'when' and 'while' macros. These should be used within an instance of reactive-thing
; or a subclass since they reference 'this'.
;
; 'when' macro. This overrides the built-in Racket 'when' - use 'racket-when' or 'cond' for that.
; There is an optional flag #:linearize, which means do a piecewise linear approximation of the test. This can
; take an additional #:dt argument for the time step to use. when constraints that use #:linearize have a restricted
; form: a comparison operator (= or equal?) followed by two expressions, e.g. (= (sin (seconds)) x). Inequality
; tests wouldn't work with a when since they would be true for more than an instant.
(define-syntax when
(syntax-rules (= equal?)
((when (= e1 e2) #:linearize #:dt dt #:epsilon epsilon e ...)
(send this add-linearized-when-holder (linearized-when-holder (lambda () (= e1 e2)) (lambda () e ...) (gensym) (lambda () (- e1 e2)) dt epsilon)))
((when (equal? e1 e2) #:linearize #:dt dt #:epsilon epsilon e ...) ; just convert (when (equal? ....) ...) to (when (= ....) ...)
(when (= e1 e2) #:linearize #:dt dt #:epsilon epsilon e ...))
((when test #:linearize e ...)
(when test #:linearize #:dt default-linearize-dt #:epsilon default-linearize-epsilon e ...))
((when test #:linearize #:dt dt e ...)
(when test #:linearize #:dt dt #:epsilon default-linearize-epsilon e ...))
((when test #:linearize #:epsilon epsilon e ...)
(when test #:linearize #:dt default-linearize-dt #:epsilon epsilon e ...))
((when test e ...)
(send this add-when-holder (when-holder (lambda () test) (lambda () e ...) (gensym))))))
; 'while' macro. #:interesting-time is an optional argument - it is a function that returns true if the current symbolic-time
; is an 'interesting' time, i.e., advance-time should stop at that time and evaluate because something may happen in the
; 'while' that will affect future state. There are currently two simple cases for which the system can synthesize
; #:interesting-time, namely checking for button-pressed? and checking for milliseconds within a given range (with a
; rigid syntax for this). Otherwise if no explicit #:interesting-time function is given it's an error.
(define-syntax while
(syntax-rules (and <= >= button-pressed? milliseconds)
((while test #:interesting-time interesting e ...)
(add-while test interesting e ...))
((while (button-pressed?) e ...)
(add-while (send this button-pressed?)
(cond [(send this button-going-down?) 'first]
[(send this button-going-up?) 'last]
[else #f])
e ...))
; The versions that check if milliseconds is within a given range assume a test like this:
; (while (and (<= 50 (milliseconds)) (<= (milliseconds) 100)) ...
; or this:
; (while (and (<= 50 (milliseconds)) (>= 100 (milliseconds))) ...
; plus the analogous versions for the lower bound test, so 4 possible combinations in all.
; NOTE: this should be rewritten in better style -- see e.g. the integral macro, which uses syntax-parse
((while (and (<= lower (milliseconds)) (<= (milliseconds) upper)) e ...)
(add-while-with-time-bounds lower upper e ...))
((while (and (<= lower (milliseconds)) (>= upper (milliseconds))) e ...)
(add-while-with-time-bounds lower upper e ...))
((while (and (>= (milliseconds) lower) (<= (milliseconds) upper)) e ...)
(add-while-with-time-bounds lower upper e ...))
((while (and (>= (milliseconds) lower) (>= upper (milliseconds))) e ...)
(add-while-with-time-bounds lower upper e ...))
((while test e ...)
(error 'while "unable to automatically synthesize #:interesting-time function"))))
; add-while and add-while-with-time-bounds are helper macros (just for internal use)
; if the body of the while has temporal constraints then we need to use pull sampling
(define-syntax-rule (add-while test interesting e ...)
(send this add-while-holder (while-holder (lambda () test)
(lambda () e ...)
(gensym)
(lambda () interesting)
(pull-sampling? '(e ...)))))
(define-syntax-rule (add-while-with-time-bounds lower upper e ...)
(add-while (and (<= lower (send this milliseconds)) (<= (send this milliseconds) upper))
(cond [(equal? lower (send this milliseconds)) 'first]
[(equal? upper (send this milliseconds)) 'last]
[else #f])
e ...))
; max-value and min-value macros
(define-syntax-rule (max-value expr)
(max-or-min max expr))
(define-syntax-rule (min-value expr)
(max-or-min min expr))
(define-syntax (max-or-min stx)
(syntax-case stx ()
[(_ fn expr)
(with-syntax ([id (datum->syntax stx (gensym))])
#'(send this max-min-helper fn (lambda () (send this wally-evaluate expr)) 'id (interesting-time?)))]))
; integral macro
; The form is (integral expr) with additional optional keyword arguments as follows:
; #:var v -- variable of integration (note that an expression is allowed here)
; #:numeric or #:symbolic -- which kind of integration to use. Can provide at most one of these, or omit.
; The default is to try symbolic, and if that doesn't work, use numeric. However, if #:symbolic is listed
; explicitly, then either symbolic integration must succeed or the system raises an exception.
; #:dt d -- time step (only allowed with #:numeric)
; Example: (integral (sin x) #:var x #:numeric #:dt 1)
; A Racket macro ninja would check the restrictions in the macro itself, but here the integral-preprocessor function checks them.
(require (for-syntax "integral-preprocessor.rkt"))
(require (for-syntax syntax/parse))
(define-syntax (integral stx)
(syntax-parse stx
[(integral e:expr (~or (~optional (~seq #:var v:expr))
(~optional (~seq (~and #:numeric numeric-kw)))
(~optional (~seq (~and #:symbolic symbolic-kw)))
(~optional (~seq #:dt dt:expr))) ...)
(let-values ([(symbolic? var symbolic-integral dt)
(integral-preprocessor (syntax->datum #'e)
(if (attribute v) (syntax->datum #'v) #f)
(attribute numeric-kw)
(attribute symbolic-kw)
(if (attribute dt) (syntax->datum #'dt) #f))])
(if symbolic?
(with-syntax ([s (datum->syntax stx symbolic-integral)] ; symbolic version
[id (datum->syntax stx (gensym))])
#'(send this integral-symbolic-run-time-fn (lambda () (send this wally-evaluate s)) 'id (interesting-time?)))
(with-syntax ([v (datum->syntax stx var)]
[d (datum->syntax stx dt)]
[id (datum->syntax stx (gensym))]) ; numeric version
#'(send this integral-numeric-run-time-fn (lambda () (send this wally-evaluate v))
(lambda () (send this wally-evaluate e)) 'id (interesting-time?) d))))]))
; Helper functions to test whether to use pull sampling
(define (pull-sampling? code)
(includes-one-of code '((seconds) (milliseconds) (mouse-position)
(button-pressed?) (button-going-down?) (button-going-up?) (button-going-up-or-down?))))
(define (includes-one-of code items)
; items should be a list of temporal function calls. Return true if code is or contains one of the calls.
(cond [(member code items) #t]
[(pair? code) (or (includes-one-of (car code) items) (includes-one-of (cdr code) items))]
[else #f]))