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

Split out (and elaborate) example

This commit is contained in:
Tony Garnock-Jones 2012-01-10 16:57:46 -05:00
parent b16d723450
commit 85709e4a0d
2 changed files with 61 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
os-example.rkt Normal file
View File

@ -0,0 +1,61 @@
#lang racket/base
(require "os.rkt")
(require racket/pretty)
(define (yield k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
'()
'()))
(define (quit)
(kernel-mode-transition (subscription 'none #f '() '())
'()
'()
'()))
(define (print x k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
(list (lambda () (pretty-print x)))
'()))
(define (super-alarm msecs)
(wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds))))
(define (sleep n k)
(kernel-mode-transition (subscription 'none
#f
'()
(list (message-handler
(super-alarm (+ (current-inexact-milliseconds) n))
(lambda (_message)
(lambda (_state)
(k))))))
'()
'()
'()))
(define (spawn thunk k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
'()
(list (runnable 'none (lambda (_) (thunk))))))
(define (example-process delay)
(print "SLEEPING"
(lambda ()
(sleep delay
(lambda ()
(yield
(lambda ()
(print "HELLO"
quit))))))))
(ground-vm (lambda (p m) (p m))
(lambda ()
(spawn (lambda ()
(example-process 1000))
(lambda ()
(example-process 2000)))))

44
os.rkt
View File

@ -315,47 +315,3 @@
[_
(error 'ground-vm
"Outermost VM may not spawn new siblings or send or receive metamessages")]))))
;---------------------------------------------------------------------------
(require racket/pretty)
(define (yield k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
'()
'()))
(define (quit)
(kernel-mode-transition (subscription 'none #f '() '())
'()
'()
'()))
(define (print x k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
(list (lambda () (pretty-print x)))
'()))
(define (super-alarm msecs)
(wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds))))
(define (sleep n k)
(kernel-mode-transition (subscription 'none
#f
'()
(list (message-handler
(super-alarm (+ (current-inexact-milliseconds) n))
(lambda (_message)
(lambda (_state)
(k))))))
'()
'()
'()))
(ground-vm (lambda (p m) (p m))
(lambda ()
(print "SLEEPING"
(lambda ()
(sleep 2000
(lambda ()
(yield
(lambda ()
(print "HELLO"
quit)))))))))