105 lines
2.8 KiB
Racket
105 lines
2.8 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/match)
|
|
(require "structs.rkt")
|
|
(require "roles.rkt")
|
|
(require "quasiqueue.rkt")
|
|
|
|
(provide vm-processes ;; (struct-out vm) doesn't work because of make-vm below (See PR13161)
|
|
vm-next-process-id
|
|
vm
|
|
vm?
|
|
|
|
(struct-out process)
|
|
(struct-out endpoint)
|
|
(struct-out eid)
|
|
|
|
make-vm
|
|
inject-process
|
|
extract-process
|
|
always-false
|
|
reset-pending-actions
|
|
process-map
|
|
endpoint-fold)
|
|
|
|
(struct vm (processes ;; (HashTable PID Process)
|
|
next-process-id ;; PID
|
|
)
|
|
#:transparent)
|
|
|
|
(struct process (debug-name ;; Any
|
|
pid ;; PID
|
|
state ;; State
|
|
spawn-ks ;; (Listof (Pairof Integer (TrapK PID State))) ;; hmm
|
|
endpoints ;; (HashTable PreEID (endpoint State))
|
|
meta-endpoints ;; (HashTable PreEID (endpoint State))
|
|
pending-actions ;; (QuasiQueue (Action State))
|
|
)
|
|
#:transparent)
|
|
|
|
(struct endpoint (id ;; eid
|
|
role ;; role
|
|
handler ;; (Handler State)
|
|
)
|
|
#:transparent)
|
|
|
|
(struct eid (pid ;; PID
|
|
pre-eid ;; PreEID
|
|
)
|
|
#:transparent)
|
|
|
|
;;---------------------------------------------------------------------------
|
|
|
|
;; make-vm : process-spec -> vm
|
|
(define (make-vm boot)
|
|
(define primordial (process '#:primordial
|
|
-1
|
|
(void)
|
|
(list)
|
|
#hash()
|
|
#hash()
|
|
(quasiqueue (spawn boot #f '#:boot-process))))
|
|
(vm (hash-set #hash() (process-pid primordial) primordial) 0))
|
|
|
|
;; inject-process : vm Process -> vm
|
|
(define (inject-process state wp)
|
|
(struct-copy vm state [processes (hash-set (vm-processes state) (process-pid wp) wp)]))
|
|
|
|
;; always-false : -> False
|
|
(define (always-false) #f)
|
|
|
|
;; extract-process : vm PID -> (values vm (Option Process))
|
|
(define (extract-process state pid)
|
|
(define wp (hash-ref (vm-processes state) pid always-false))
|
|
(values (if wp
|
|
(struct-copy vm state [processes (hash-remove (vm-processes state) pid)])
|
|
state)
|
|
wp))
|
|
|
|
;; reset-pending-actions : (All (State) (process State) -> (process State))
|
|
(define (reset-pending-actions p)
|
|
(struct-copy process p [pending-actions (empty-quasiqueue)]))
|
|
|
|
;; process-map : (All (State) (process State) -> (process State)) vm -> vm
|
|
;; TODO: simplify
|
|
(define (process-map f state)
|
|
(for/fold ([state state]) ([pid (in-hash-keys (vm-processes state))])
|
|
(let-values (((state wp) (extract-process state pid)))
|
|
(if (not wp)
|
|
state
|
|
(inject-process state (f wp))))))
|
|
|
|
;; endpoint-fold : (All (A) (All (State) (process State) (endpoint State) A -> A) A vm -> A)
|
|
(define (endpoint-fold f seed state)
|
|
(for/fold ([seed seed]) ([pid (in-hash-keys (vm-processes state))])
|
|
(let-values (((state wp) (extract-process state pid)))
|
|
(if (not wp)
|
|
seed
|
|
(for/fold ([seed seed]) ([pre-eid (in-hash-keys (process-endpoints wp))])
|
|
(define ep (hash-ref (process-endpoints wp) pre-eid))
|
|
(f wp ep seed))))))
|
|
|
|
;;; Local Variables:
|
|
;;; eval: (put 'unwrap-process 'scheme-indent-function 3)
|
|
;;; End:
|