diff --git a/syndicate/examples/box-and-client.rkt b/syndicate/examples/box-and-client.rkt new file mode 100644 index 0000000..a52fd44 --- /dev/null +++ b/syndicate/examples/box-and-client.rkt @@ -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))))) diff --git a/syndicate/ground.rkt b/syndicate/ground.rkt new file mode 100644 index 0000000..1cef01c --- /dev/null +++ b/syndicate/ground.rkt @@ -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)))) diff --git a/syndicate/lang.rkt b/syndicate/lang.rkt new file mode 100644 index 0000000..0fa9312 --- /dev/null +++ b/syndicate/lang.rkt @@ -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 ...))))])) diff --git a/syndicate/main.rkt b/syndicate/main.rkt new file mode 100644 index 0000000..24a5b68 --- /dev/null +++ b/syndicate/main.rkt @@ -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")