Add (seal)s, for hiding structure from the routing table. Drastically improves big-bang example performance.
This commit is contained in:
parent
eaa59161dc
commit
7ed7ce096d
|
@ -30,7 +30,7 @@
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
(struct window (id x y z image) #:transparent)
|
(struct window (id x y z image) #:transparent) ;; image must be sealed
|
||||||
|
|
||||||
(struct to-server (message) #:transparent)
|
(struct to-server (message) #:transparent)
|
||||||
(struct from-server (message) #:transparent)
|
(struct from-server (message) #:transparent)
|
||||||
|
@ -44,7 +44,7 @@
|
||||||
|
|
||||||
(define (update-window id x y image #:z [z 0])
|
(define (update-window id x y image #:z [z 0])
|
||||||
(patch-seq (retract (window id ? ? ? ?) #:meta-level 1)
|
(patch-seq (retract (window id ? ? ? ?) #:meta-level 1)
|
||||||
(assert (window id x y z image) #:meta-level 1)))
|
(assert (window id x y z (seal image)) #:meta-level 1)))
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -114,12 +114,12 @@
|
||||||
(let loop ((ws (bb-windows b)))
|
(let loop ((ws (bb-windows b)))
|
||||||
(match ws
|
(match ws
|
||||||
['() #f]
|
['() #f]
|
||||||
[(cons (window id x y _ image) ws)
|
[(cons (window id x y _ (seal image)) ws)
|
||||||
(if (inside? mx my x y image) id (loop ws))])))
|
(if (inside? mx my x y image) id (loop ws))])))
|
||||||
|
|
||||||
(define (render b)
|
(define (render b)
|
||||||
(for/fold [(scene empty-image)] [(w (bb-windows b))]
|
(for/fold [(scene empty-image)] [(w (bb-windows b))]
|
||||||
(match-define (window _ x y z image) w)
|
(match-define (window _ x y z (seal image)) w)
|
||||||
(overlay/xy scene x y image)))
|
(overlay/xy scene x y image)))
|
||||||
|
|
||||||
(define (update-active-window active-id)
|
(define (update-active-window active-id)
|
||||||
|
|
|
@ -9,6 +9,8 @@
|
||||||
(struct-out transition)
|
(struct-out transition)
|
||||||
(struct-out world)
|
(struct-out world)
|
||||||
|
|
||||||
|
(struct-out seal)
|
||||||
|
|
||||||
(all-from-out "patch.rkt")
|
(all-from-out "patch.rkt")
|
||||||
|
|
||||||
;; imported from route.rkt:
|
;; imported from route.rkt:
|
||||||
|
@ -104,6 +106,12 @@
|
||||||
[(define (prospect-pretty-print w [p (current-output-port)])
|
[(define (prospect-pretty-print w [p (current-output-port)])
|
||||||
(pretty-print-world w p))])
|
(pretty-print-world w p))])
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Seals are used by protocols to prevent the routing tries from
|
||||||
|
;; examining internal structure of values.
|
||||||
|
|
||||||
|
(struct seal (contents)) ;; NB. Neither transparent nor prefab
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (event? x) (or (patch? x) (message? x)))
|
(define (event? x) (or (patch? x) (message? x)))
|
||||||
|
|
Loading…
Reference in New Issue