syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Cosmetic (and remove quasi-queue definitions)

This commit is contained in:
Tony Garnock-Jones 2012-03-24 19:23:27 -04:00
parent 97304006b8
commit df3d76ae26
1 changed files with 15 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
os2.rkt
View File

@ -103,6 +103,7 @@
(struct at-meta-level (preaction) #:prefab)
;;---------------------------------------------------------------------------
;; role macro
(require (for-syntax syntax/parse))
(require (for-syntax racket/base))
@ -152,6 +153,9 @@
(handlers presence-handler absence-handler message-handler)
ready-handler)))])))
;;---------------------------------------------------------------------------
;; Smarter constructors for transitions and preactions.
(define (make-transition state . actions) (transition state actions))
(define (make-add-role topic handlers [k #f]) (add-role topic handlers k))
(define (make-delete-role eid [reason #f]) (delete-role eid reason))
@ -202,48 +206,25 @@
(not (topic-virtual? remote-topic))))
;;---------------------------------------------------------------------------
;; QuasiQueue<X>
(define empty-quasi-queue '())
;; QuasiQueue<X> -> Boolean
(define quasi-queue-empty? null?)
;; X QuasiQueue<X> -> QuasiQueue<X>
(define (quasi-enqueue-one thing existing-quasi-queue)
(cons thing existing-quasi-queue))
;; List<X> QuasiQueue<X> -> QuasiQueue<X>
(define (quasi-enqueue-many many-things-in-order existing-quasi-queue)
(append (reverse many-things-in-order) existing-quasi-queue))
;; QuasiQueue<X> -> List<X>
(define (quasi-queue->list quasi-queue)
(reverse quasi-queue))
;; List<X> -> QuasiQueue<X>
(define (list->quasi-queue xs)
(reverse xs))
;;---------------------------------------------------------------------------
;; Core virtualizable virtual machine.
(define (make-vm boot)
(vm (hash)
(hash)
0
(list->quasi-queue (list (cons -1 (spawn boot #f))))))
(list (cons -1 (spawn boot #f)))))
(define (run-vm state)
(let loop ((remaining-actions (quasi-queue->list (vm-pending-actions state)))
(state (struct-copy vm state [pending-actions empty-quasi-queue]))
(outbound-actions empty-quasi-queue))
(let loop ((remaining-actions (reverse (vm-pending-actions state)))
(state (struct-copy vm state [pending-actions '()]))
(outbound-actions '()))
(match remaining-actions
['() (transition state (quasi-queue->list outbound-actions))]
['() (transition state (reverse outbound-actions))]
[(cons (cons pid action) rest)
(match action
[(at-meta-level preaction)
(define transformed-preaction (transform-meta-action pid preaction))
(loop rest state (quasi-enqueue-one transformed-preaction outbound-actions))]
(loop rest state (cons transformed-preaction outbound-actions))]
[preaction
(loop rest (perform-action pid preaction state) outbound-actions)])])))
@ -394,8 +375,8 @@
(define (enqueue-actions state pid actions)
(struct-copy vm state
[pending-actions (quasi-enqueue-many (for/list ([a (flatten actions)]) (cons pid a))
(vm-pending-actions state))]))
[pending-actions (append (reverse (for/list ([a (flatten actions)]) (cons pid a)))
(vm-pending-actions state))]))
(define (wrap-trapk pid trapk)
(lambda args
@ -425,7 +406,7 @@
[(transition state actions)
(when (not (null? actions))
(error 'ground-vm "No meta-actions available in ground-vm: ~v" actions))
(define waiting? (quasi-queue-empty? (vm-pending-actions state)))
(define waiting? (null? (vm-pending-actions state)))
(define active-events (for/list ([(eid e) (in-hash (vm-endpoints state))]
#:when (and (evt? (topic-pattern (endpoint-topic e)))
(eq? (topic-role (endpoint-topic e))
@ -437,14 +418,10 @@
message
state))))))
(if (and waiting? (null? active-events))
;; About to block, and nothing can wake us
'done
'done ;; About to block, and nothing can wake us
(let ((interruptk (apply sync
(if waiting?
never-evt
(wrap-evt always-evt (lambda (dummy) values)))
active-events)))
(loop (interruptk state))))])))
;;(require racket/trace)
;;(trace perform-action)