syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

internal event business

This commit is contained in:
Sam Caldwell 2019-07-01 15:57:50 -04:00
parent 3c3291ffa4
commit 9a21a811a3
1 changed files with 49 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
racket/typed/proto.rkt
View File

@ -56,6 +56,10 @@
(define StartEvt 'Start) (define StartEvt 'Start)
(define StopEvt 'Stop) (define StopEvt 'Stop)
(define DataflowEvt 'Dataflow) (define DataflowEvt 'Dataflow)
;; Any -> Bool
;; recognize DataflowEvt
(define (DataflowEvt? x)
(equal? x DataflowEvt))
;; a D+ is a D with StartEvt and StopEvt replaced with variants that name the ;; a D+ is a D with StartEvt and StopEvt replaced with variants that name the
;; specified facet, ;; specified facet,
@ -259,35 +263,32 @@
(define new-events (route-internal (hash-ref assertion# prev) (define new-events (route-internal (hash-ref assertion# prev)
(hash-ref assertion# to))) (hash-ref assertion# to)))
;; TODO - this is saying something about how the implementation schedules handlers; ;; TODO - this is saying something about how the implementation schedules handlers;
;; I think it should be something like exploring (append with (permutations new-events)) ;; It could be doing something like exploring (append with (permutations new-events))
(define started (for/list ([fn (in-set (set-subtract to prev))]) (StartOf fn))) (define started (for/list ([fn (in-set (set-subtract to prev))]) (StartOf fn)))
(define stopped (for/list ([fn (in-set (set-subtract prev to))]) (StopOf fn))) (define stopped (for/list ([fn (in-set (set-subtract prev to))]) (StopOf fn)))
(define new-events* (cons DataflowEvt (append started stopped (set->list new-events)))) (define new-events* (append started stopped (set->list new-events)))
(define pending (append with new-events*))
(define pending/first-relevant ;; (Listof D+) -> (Listof WorkItem)
(dropf pending ;; Try to dispatch the first relevant pending event, which yields a
(lambda (evt) ;; collection of work items based on its effects
(not (define (pending-evts->work-items pending-evts)
(for/or ([D (in-hash-keys txn#)]) (define pending/first-relevant
;; TODO - think I want non-empty intersection instead of subtyping (dropf pending-evts
(D<:? evt D)))))) (lambda (evt)
(match pending/first-relevant (not
['() (for/or ([D (in-hash-keys txn#)])
(define new-paths-work ;; TODO - think I want non-empty intersection instead of subtyping
(for*/list (#:unless (set-member? visited to) (and (D<:? evt D)
[(D txns) (in-hash txn#)] ;; don't want dataflow edges to gobble up all events
#:when (external-evt? D) (implies (DataflowEvt? D) (DataflowEvt? evt))))))))
#:unless (equal? D DataflowEvt) (match pending/first-relevant
[t (in-set txns)]) ['()
(match-define (transition es dst) t) '()]
(work-item to '() dst D (effs->internal-events es) es))) [(cons evt more-pending)
(define new-st# (update-path st# from to by effs)) (define path/r+ (cons to path/r))
(walk (append more-work new-paths-work) visited+ new-st#)]
[(cons evt more-pending)
(define path/r+ (cons to path/r))
(define more-labor
(for*/list ([(D ts) (in-hash txn#)] (for*/list ([(D ts) (in-hash txn#)]
#:when (D<:? evt D) #:when (D<:? evt D)
#:when (implies (DataflowEvt? D) (DataflowEvt? evt))
[t (in-set ts)]) [t (in-set ts)])
(match-define (transition more-effs dest) t) (match-define (transition more-effs dest) t)
(when (and (member dest path/r+) (when (and (member dest path/r+)
@ -303,8 +304,29 @@
dest dest
by by
(append more-pending internal-effs) (append more-pending internal-effs)
(append effs more-effs)))) (append effs more-effs)))]))
(walk (append more-work more-labor) visited+ st#)])]))
(define pending (append with new-events*))
(define pending*
(if (hash-has-key? txn# DataflowEvt)
(list pending (cons DataflowEvt pending))
(list pending)))
(define induced-work (map pending-evts->work-items pending*))
(define induced-work* (flatten induced-work))
(cond
[(empty? (first induced-work))
(define new-paths-work
(for*/list (#:unless (set-member? visited to)
[(D txns) (in-hash txn#)]
#:when (external-evt? D)
#:unless (equal? D DataflowEvt)
[t (in-set txns)])
(match-define (transition es dst) t)
(work-item to '() dst D (effs->internal-events es) es)))
(define new-st# (update-path st# from to by effs))
(walk (append more-work induced-work* new-paths-work) visited+ new-st#)]
[else
(walk (append more-work induced-work*) visited+ st#)])]))
(local-require racket/trace) (local-require racket/trace)
#;(trace walk) #;(trace walk)
(walk (list (work-item (set) '() st0 StartEvt '() '())) (walk (list (work-item (set) '() st0 StartEvt '() '()))