Correctly (?) prune field-tables

This commit is contained in:
Tony Garnock-Jones 2016-07-09 17:23:43 -04:00
parent 3bc95aeaeb
commit 1e1fef6a6e
2 changed files with 14 additions and 12 deletions

View File

@ -97,8 +97,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parameters. Many of these are *updated* during facet execution!
(define (empty-field-table)
(hash))
;; Parameterof FieldTable
(define current-field-table (make-parameter (hash)))
(define current-field-table (make-parameter (empty-field-table)))
;; Parameterof ActorState
(define current-actor-state (make-parameter #f))
@ -547,12 +550,16 @@
'()
(seteqv)
parent-fid)))
(when parent-fid
(update-facet! parent-fid (lambda (f)
(and f
(struct-copy facet f
[children (set-add (facet-children f) fid)])))))
(with-current-facet fid (current-field-table) #f
(define starting-field-table
(if parent-fid
(match (lookup-facet parent-fid)
[#f (current-field-table)] ;; TODO: Is this correct???
[f
(store-facet! parent-fid (struct-copy facet f
[children (set-add (facet-children f) fid)]))
(facet-field-table f)])
(empty-field-table)))
(with-current-facet fid starting-field-table #f
(setup-proc)
(update-facet! fid (lambda (f) (and f
(struct-copy facet f

View File

@ -23,11 +23,6 @@
(define (draggable-shape name orig-x orig-y image)
(define (window-at x y) (window name x y 10 (seal image)))
(define (mouse-left-event-type? t) (member t '("leave" "button-up")))
;;
;; N.B. Currently (9 July 2016), fields are not properly
;; garbage-collected on tail-calls between states, as you pick up
;; and put down shapes, you'll see their field-tables grow.
;;
(define (idle ticks0 x0 y0)
(react (field [ticks ticks0] [x x0] [y y0])
(assert (window-at (x) (y)) #:meta-level 1)