(define process-def-hash-table (make-hash-table))
(define process-name->process-def
(case-lambda
((name process-def)
(hash-table-put! process-def-hash-table name process-def))
((name)
(hash-table-get process-def-hash-table name
(lambda () #f)))))
(define (process-name? x)
(and (symbol? x)
(process-name->process-def x)))
(define-values (struct:process-def
process-def-constructor
process-def?
process-def-field-ref
set-process-def-field!)
(make-struct-type 'process-def #f 3 0))
(define process-def-name
(make-struct-field-accessor process-def-field-ref 0 'name))
(define set-process-def-name!
(make-struct-field-mutator set-process-def-field! 0 'name))
(define process-def-body-function
(make-struct-field-accessor process-def-field-ref 1 'body-function))
(define set-process-def-body-function!
(make-struct-field-mutator set-process-def-field! 1 'body-function))
(define process-def-make
(make-struct-field-accessor process-def-field-ref 2 'make))
(define set-process-def-make!
(make-struct-field-mutator set-process-def-field! 2 'make))
(define (make-process-def name body-function make)
(let ((process-def (process-def-constructor name body-function make)))
(process-name->process-def name process-def)
process-def))
(define-values (struct:process
process-constructor
process?
process-field-ref
set-process-field!)
(make-struct-type 'process #f 6 0))
(define process-process-def
(make-struct-field-accessor process-field-ref 0 'process-def))
(define set-process-process-def!
(make-struct-field-mutator set-process-field! 0 'process-def))
(define process-event
(make-struct-field-accessor process-field-ref 1 'event))
(define set-process-event!
(make-struct-field-mutator set-process-field! 1 'event))
(define PROCESS-TERMINATED -1)
(define PROCESS-CREATED 0)
(define PROCESS-ACTIVE 1)
(define PROCESS-WAITING/WORKING 2)
(define PROCESS-WORKING-CONTINUOUSLY 3)
(define PROCESS-DELAYED 4)
(define PROCESS-INTERRUPTED 5)
(define PROCESS-SUSPENDED 6)
(define process-state
(make-struct-field-accessor process-field-ref 2 'state))
(define set-process-state!
(make-struct-field-mutator set-process-field! 2 'state))
(define process-continuous-variables
(make-struct-field-accessor process-field-ref 3 'continuous-variables))
(define set-process-continuous-variables!
(make-struct-field-mutator set-process-field! 3 'continuous-variables))
(define process-terminating-condition
(make-struct-field-accessor process-field-ref 4 'termination-condition))
(define set-process-terminating-condition!
(make-struct-field-mutator set-process-field! 4 'terminating-condition))
(define process-differentiation-function
(make-struct-field-accessor process-field-ref 5 'differentiation-function))
(define set-process-differentiation-function!
(make-struct-field-mutator set-process-field! 5 'differentiation-function))
(define (process-name process)
(process-def-name (process-process-def process)))
(define (process-time process)
(event-time (process-event process)))
(define (set-process-time! process time)
(set-event-time! (process-event process) time))
(define (make-process name arguments)
(let* ((process-def (process-name->process-def name))
(process ((process-def-make process-def)
process-def #f PROCESS-CREATED '() #f #f))) (set-process-event! process
(make-event
0.0
process
(process-def-body-function process-def)
arguments))
process))
(define-syntax (define-process stx)
(syntax-case stx ()
((define-process (name . arguments)
body ...)
(with-syntax ((self (datum->syntax-object
(syntax define-process)
'self)))
(syntax (begin
(make-process-def
'name
(lambda arguments
(let ((self (current-simulation-process)))
body ...))
process-constructor)
(void)))))))