#lang racket/base
;; Trivial demonstration of an os2.rkt virtual machine.

(require "os2.rkt")
(require racket/pretty)

(define (super-alarm msecs)
  (wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds))))

(define (sleep n k)
  (transition k
    (add-role (topic-subscriber (super-alarm (+ (current-inexact-milliseconds) n)))
	      (handlers #f #f (lambda (eid topic now)
				(lambda (k)
				  (extend-transition (k)
				    (delete-role eid))))))))

(define (example-process delay)
  (write `(sleeping for ,delay milliseconds))
  (newline)
  (sleep delay (lambda ()
		 (write `(awoke after ,delay milliseconds))
		 (newline)
		 (transition 'no-state (kill)))))

(define spy
  (lambda ()
    (define (hs label)
      (define ((w kind) . args) (write `(,label ,kind ,@args)) (newline) values)
      (handlers (w 'presence)
		(w 'absence)
		(w 'message)))
    (transition 'spy-state
      (add-role (topic-publisher (wild) #:virtual? #t) (hs 'subscriber->publisher))
      (add-role (topic-subscriber (wild) #:virtual? #t) (hs 'publisher->subscriber)))))

(ground-vm (lambda ()
	     (transition 'no-state
	       (spawn spy)
	       (spawn (lambda () (example-process 1000)))
	       (spawn (lambda () (example-process 2000)))
	       (kill))))