First stab at #lang infrastructure

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)))))

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))))

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 ...))))]))

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")