#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
    (role (topic-subscriber (super-alarm (+ (current-inexact-milliseconds) n)))
      #:state k
      #:id id
      #:on-ready (begin (write `(ready ,id)) (newline) k)
      [now (extend-transition (k) (delete-role id))])))

(define (example-process delay)
  (write `(sleeping for ,delay milliseconds))
  (newline)
  (sleep delay (lambda ()
		 (if (> delay 1500)
		     (error 'example-process "Oh noes!")
		     (begin (write `(awoke after ,delay milliseconds))
			    (newline)
			    (transition 'no-state (kill)))))))

(define spy
  (lambda (spy-pid)
    (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 (boot-pid)
	     (transition 'no-state
	       (spawn spy)
	       (spawn (lambda (pid) (example-process 1000)))
	       (spawn (lambda (pid) (example-process 2000)))
	       (kill))))