First stab at #lang infrastructure
This commit is contained in:
parent
f40e7c15cc
commit
204197c3eb
|
@ -0,0 +1,19 @@
|
||||||
|
#lang imperative-syndicate
|
||||||
|
;; Simple mutable box and count-to-infinity box client.
|
||||||
|
|
||||||
|
(message-struct set-box (new-value))
|
||||||
|
(assertion-struct box-state (value))
|
||||||
|
|
||||||
|
(spawn (field [current-value 0])
|
||||||
|
(assert (box-state (current-value)))
|
||||||
|
(stop-when-true (= (current-value) 10)
|
||||||
|
(log-info "box: terminating"))
|
||||||
|
(on (message (set-box $new-value))
|
||||||
|
(log-info "box: taking on new-value ~v" new-value)
|
||||||
|
(current-value new-value)))
|
||||||
|
|
||||||
|
(spawn (stop-when (retracted (observe (set-box _)))
|
||||||
|
(log-info "client: box has gone"))
|
||||||
|
(on (asserted (box-state $v))
|
||||||
|
(log-info "client: learned that box's value is now ~v" v)
|
||||||
|
(send! (set-box (+ v 1)))))
|
|
@ -0,0 +1,9 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide run-ground)
|
||||||
|
|
||||||
|
(require "dataspace.rkt")
|
||||||
|
|
||||||
|
(define (run-ground boot-proc)
|
||||||
|
(define ds (make-dataspace (lambda () (schedule-script! (current-actor) boot-proc))))
|
||||||
|
(let loop () (when (run-scripts! ds) (loop))))
|
|
@ -0,0 +1,113 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide (rename-out [module-begin #%module-begin])
|
||||||
|
activate
|
||||||
|
require/activate
|
||||||
|
current-ground-dataspace
|
||||||
|
begin-for-declarations ;; TODO: this seems like a horrible hack
|
||||||
|
(except-out (all-from-out racket/base) #%module-begin sleep)
|
||||||
|
(all-from-out racket/match)
|
||||||
|
(all-from-out "main.rkt")
|
||||||
|
(for-syntax (all-from-out racket/base)))
|
||||||
|
|
||||||
|
(require racket/match)
|
||||||
|
(require "main.rkt")
|
||||||
|
(require (for-syntax racket/base syntax/kerncase))
|
||||||
|
|
||||||
|
(define-syntax (activate stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ module-path ...)
|
||||||
|
(syntax/loc stx
|
||||||
|
(begin
|
||||||
|
(let ()
|
||||||
|
(local-require (submod module-path syndicate-main))
|
||||||
|
(activate!))
|
||||||
|
...))]))
|
||||||
|
|
||||||
|
(define-syntax (require/activate stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ module-path ...)
|
||||||
|
(syntax/loc stx
|
||||||
|
(begin
|
||||||
|
(require module-path ...)
|
||||||
|
(activate module-path ...)))]))
|
||||||
|
|
||||||
|
(define-syntax-rule (begin-for-declarations decl ...)
|
||||||
|
(begin decl ...))
|
||||||
|
|
||||||
|
(define current-ground-dataspace (make-parameter #f))
|
||||||
|
|
||||||
|
(define-syntax (module-begin stx)
|
||||||
|
(unless (eq? (syntax-local-context) 'module-begin)
|
||||||
|
(raise-syntax-error #f "allowed only around a module body" stx))
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ forms ...)
|
||||||
|
(let ()
|
||||||
|
|
||||||
|
(define (accumulate-actions activation-forms final-forms forms)
|
||||||
|
(cond
|
||||||
|
[(null? forms)
|
||||||
|
(define final-stx
|
||||||
|
#`(#%module-begin
|
||||||
|
;----------------------------------------
|
||||||
|
; The final module has three pieces:
|
||||||
|
; - a `syndicate-main` submodule, for activation
|
||||||
|
; - a `main` submodule, for programs
|
||||||
|
; - actual definitions, for everything else.
|
||||||
|
; The `main` submodule is split into two pieces,
|
||||||
|
; in order to initialise defaults that can then
|
||||||
|
; be overridden by the module being compiled.
|
||||||
|
|
||||||
|
(module+ syndicate-main
|
||||||
|
(provide activate!* activate!)
|
||||||
|
(define activated? #f)
|
||||||
|
(define (activate!*)
|
||||||
|
#,@(reverse activation-forms))
|
||||||
|
(define (activate!)
|
||||||
|
(when (not activated?)
|
||||||
|
(set! activated? #t)
|
||||||
|
(activate!*))))
|
||||||
|
|
||||||
|
(module+ main (current-ground-dataspace run-ground))
|
||||||
|
|
||||||
|
#,@(reverse final-forms)
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(require (submod ".." syndicate-main))
|
||||||
|
((current-ground-dataspace) activate!))
|
||||||
|
|
||||||
|
;----------------------------------------
|
||||||
|
))
|
||||||
|
;;(pretty-print (syntax->datum final-stx))
|
||||||
|
final-stx]
|
||||||
|
|
||||||
|
[else
|
||||||
|
(syntax-case (local-expand (car forms)
|
||||||
|
'module
|
||||||
|
(append (list #'module+
|
||||||
|
#'begin-for-declarations)
|
||||||
|
(kernel-form-identifier-list))) ()
|
||||||
|
[(head rest ...)
|
||||||
|
(cond
|
||||||
|
[(free-identifier=? #'head #'begin)
|
||||||
|
(accumulate-actions activation-forms
|
||||||
|
final-forms
|
||||||
|
(append (syntax->list #'(rest ...)) (cdr forms)))]
|
||||||
|
[(ormap (lambda (i) (free-identifier=? #'head i))
|
||||||
|
(syntax->list #'(define-values define-syntaxes begin-for-syntax
|
||||||
|
module module* module+
|
||||||
|
#%module-begin
|
||||||
|
#%require #%provide
|
||||||
|
begin-for-declarations)))
|
||||||
|
(accumulate-actions activation-forms
|
||||||
|
(cons (car forms) final-forms)
|
||||||
|
(cdr forms))]
|
||||||
|
[else
|
||||||
|
(accumulate-action (car forms) activation-forms final-forms (cdr forms))])]
|
||||||
|
[non-pair-syntax
|
||||||
|
(accumulate-action (car forms) activation-forms final-forms (cdr forms))])]))
|
||||||
|
|
||||||
|
(define (accumulate-action action activation-forms final-forms remaining-forms)
|
||||||
|
(accumulate-actions (cons action activation-forms) final-forms remaining-forms))
|
||||||
|
|
||||||
|
(accumulate-actions '() '() (syntax->list #'(forms ...))))]))
|
|
@ -0,0 +1,11 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide (all-from-out "dataspace.rkt")
|
||||||
|
(all-from-out "syntax.rkt")
|
||||||
|
(all-from-out "ground.rkt"))
|
||||||
|
|
||||||
|
(module reader syntax/module-reader imperative-syndicate/lang)
|
||||||
|
|
||||||
|
(require "dataspace.rkt")
|
||||||
|
(require "syntax.rkt")
|
||||||
|
(require "ground.rkt")
|
Loading…
Reference in New Issue