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 StopEvt 'Stop)
(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
;; specified facet,
@ -259,35 +263,32 @@
(define new-events (route-internal (hash-ref assertion# prev)
(hash-ref assertion# to)))
;; 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 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 pending (append with new-events*))
(define pending/first-relevant
(dropf pending
(lambda (evt)
(not
(for/or ([D (in-hash-keys txn#)])
;; TODO - think I want non-empty intersection instead of subtyping
(D<:? evt D))))))
(match pending/first-relevant
['()
(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 new-paths-work) visited+ new-st#)]
[(cons evt more-pending)
(define path/r+ (cons to path/r))
(define more-labor
(define new-events* (append started stopped (set->list new-events)))
;; (Listof D+) -> (Listof WorkItem)
;; Try to dispatch the first relevant pending event, which yields a
;; collection of work items based on its effects
(define (pending-evts->work-items pending-evts)
(define pending/first-relevant
(dropf pending-evts
(lambda (evt)
(not
(for/or ([D (in-hash-keys txn#)])
;; TODO - think I want non-empty intersection instead of subtyping
(and (D<:? evt D)
;; don't want dataflow edges to gobble up all events
(implies (DataflowEvt? D) (DataflowEvt? evt))))))))
(match pending/first-relevant
['()
'()]
[(cons evt more-pending)
(define path/r+ (cons to path/r))
(for*/list ([(D ts) (in-hash txn#)]
#:when (D<:? evt D)
#:when (implies (DataflowEvt? D) (DataflowEvt? evt))
[t (in-set ts)])
(match-define (transition more-effs dest) t)
(when (and (member dest path/r+)
@ -303,8 +304,29 @@
dest
by
(append more-pending internal-effs)
(append effs more-effs))))
(walk (append more-work more-labor) visited+ st#)])]))
(append effs more-effs)))]))
(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)
#;(trace walk)
(walk (list (work-item (set) '() st0 StartEvt '() '()))