2016-01-23 23:24:07 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
|
|
|
(require (for-syntax racket/base syntax/kerncase))
|
|
|
|
|
|
|
|
(require racket/match)
|
|
|
|
(require "main.rkt")
|
2016-07-15 13:50:29 +00:00
|
|
|
(require (submod "actor.rkt" for-module-begin))
|
2016-07-28 19:39:52 +00:00
|
|
|
(require "store.rkt")
|
2016-01-23 23:24:07 +00:00
|
|
|
|
|
|
|
(provide (rename-out [module-begin #%module-begin])
|
2016-07-12 19:05:56 +00:00
|
|
|
activate
|
|
|
|
require/activate
|
2016-07-16 20:07:34 +00:00
|
|
|
current-ground-dataspace
|
2016-07-23 15:28:46 +00:00
|
|
|
begin-for-declarations
|
2016-07-17 16:47:24 +00:00
|
|
|
(except-out (all-from-out racket/base) #%module-begin sleep)
|
2016-01-23 23:24:07 +00:00
|
|
|
(all-from-out racket/match)
|
|
|
|
(all-from-out "main.rkt")
|
|
|
|
(for-syntax (all-from-out racket/base)))
|
|
|
|
|
2016-07-12 19:05:56 +00:00
|
|
|
(define-syntax (activate stx)
|
|
|
|
(syntax-case stx ()
|
|
|
|
[(_ module-path ...)
|
|
|
|
#'(begin
|
|
|
|
(let ()
|
|
|
|
(local-require (submod module-path syndicate-main))
|
|
|
|
(activate!))
|
|
|
|
...)]))
|
|
|
|
|
|
|
|
(define-syntax (require/activate stx)
|
|
|
|
(syntax-case stx ()
|
|
|
|
[(_ module-path ...)
|
|
|
|
#'(begin
|
|
|
|
(require module-path ...)
|
|
|
|
(activate module-path ...))]))
|
|
|
|
|
2016-07-23 15:28:46 +00:00
|
|
|
(define-syntax-rule (begin-for-declarations decl ...)
|
|
|
|
(begin decl ...))
|
|
|
|
|
2016-07-16 20:07:34 +00:00
|
|
|
(define current-ground-dataspace (make-parameter #f))
|
|
|
|
|
2016-01-23 23:24:07 +00:00
|
|
|
(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 action-ids final-forms forms)
|
|
|
|
(if (null? forms)
|
|
|
|
(let ((final-stx
|
Support `module+` in Syndicate #langs. Closes #2.
Adding `#'module+` explicitly to the stop-list for local-expand stops
the infinite recursion (problem 1 in the issue description). The code
goes on to treat it like `#'module` and `#'module+`, namely as a
non-action-producing form.
Problem 2 in the issue description is interesting. I haven't done
anything in particular to address the production of unbounded `X` ->
`(begin X)` expansions, but it seems not currently to be a problem;
and, weirdly (?), submodules in a `#lang syndicate` or `#lang
syndicate/actor` module do not seem to inherit the `#%module-begin` of
their container! That is, `(module+ main)`, `(module+ test)` etc. all
seem to have a `racket/base` `#%module-begin`, though I've not looked
very far into this.
Most peculiar on this front is that if the `#,@(reverse final-forms)`
precedes the `(module+ syndicate-main ...)`, and the module being
processed includes, say, a `(module+ main)`, then for some reason the
resulting `main` submodule *is* treated as having a `syndicate/lang`
`#%module-begin` (thus causing problems as suggested in the issue
description)! I *really* don't understand why that might be, and
haven't spent very much time investigating after I noticed that so
long as the `main`-required `syndicate-main` submodule preceded all
other submodule declarations, things seemed to work out.
This whole approach is still a bit dicey: for example, the following
will erroneously treat `(foo quux)` as an expression yielding actions,
rather than a struct declaration:
#lang syndicate
(define-syntax-rule (foo x) (struct x ()))
(foo quux)
2016-07-16 19:40:20 +00:00
|
|
|
#`(#%module-begin (module+ syndicate-main
|
2016-07-12 19:05:56 +00:00
|
|
|
(provide boot-actions activate!)
|
|
|
|
(define activated? #f)
|
|
|
|
(define boot-actions (list #,@(reverse action-ids)))
|
|
|
|
(define (activate!)
|
|
|
|
(when (not activated?)
|
|
|
|
(set! activated? #t)
|
|
|
|
boot-actions)))
|
2016-07-16 20:07:34 +00:00
|
|
|
(module+ main
|
|
|
|
(current-ground-dataspace run-ground))
|
Support `module+` in Syndicate #langs. Closes #2.
Adding `#'module+` explicitly to the stop-list for local-expand stops
the infinite recursion (problem 1 in the issue description). The code
goes on to treat it like `#'module` and `#'module+`, namely as a
non-action-producing form.
Problem 2 in the issue description is interesting. I haven't done
anything in particular to address the production of unbounded `X` ->
`(begin X)` expansions, but it seems not currently to be a problem;
and, weirdly (?), submodules in a `#lang syndicate` or `#lang
syndicate/actor` module do not seem to inherit the `#%module-begin` of
their container! That is, `(module+ main)`, `(module+ test)` etc. all
seem to have a `racket/base` `#%module-begin`, though I've not looked
very far into this.
Most peculiar on this front is that if the `#,@(reverse final-forms)`
precedes the `(module+ syndicate-main ...)`, and the module being
processed includes, say, a `(module+ main)`, then for some reason the
resulting `main` submodule *is* treated as having a `syndicate/lang`
`#%module-begin` (thus causing problems as suggested in the issue
description)! I *really* don't understand why that might be, and
haven't spent very much time investigating after I noticed that so
long as the `main`-required `syndicate-main` submodule preceded all
other submodule declarations, things seemed to work out.
This whole approach is still a bit dicey: for example, the following
will erroneously treat `(foo quux)` as an expression yielding actions,
rather than a struct declaration:
#lang syndicate
(define-syntax-rule (foo x) (struct x ()))
(foo quux)
2016-07-16 19:40:20 +00:00
|
|
|
#,@(reverse final-forms)
|
2016-07-12 19:05:56 +00:00
|
|
|
(module+ main
|
|
|
|
(require (submod ".." syndicate-main))
|
2016-07-16 20:07:34 +00:00
|
|
|
((current-ground-dataspace) (activate!))))))
|
2016-01-23 23:24:07 +00:00
|
|
|
;;(pretty-print (syntax->datum final-stx))
|
|
|
|
final-stx)
|
|
|
|
(syntax-case (local-expand (car forms)
|
|
|
|
'module
|
2016-07-23 15:28:46 +00:00
|
|
|
(append (list #'module+
|
|
|
|
#'begin-for-declarations)
|
|
|
|
(kernel-form-identifier-list))) ()
|
2016-01-23 23:24:07 +00:00
|
|
|
[(head rest ...)
|
|
|
|
(if (free-identifier=? #'head #'begin)
|
|
|
|
(accumulate-actions action-ids
|
|
|
|
final-forms
|
|
|
|
(append (syntax->list #'(rest ...)) (cdr forms)))
|
|
|
|
(if (ormap (lambda (i) (free-identifier=? #'head i))
|
|
|
|
(syntax->list #'(define-values define-syntaxes begin-for-syntax
|
Support `module+` in Syndicate #langs. Closes #2.
Adding `#'module+` explicitly to the stop-list for local-expand stops
the infinite recursion (problem 1 in the issue description). The code
goes on to treat it like `#'module` and `#'module+`, namely as a
non-action-producing form.
Problem 2 in the issue description is interesting. I haven't done
anything in particular to address the production of unbounded `X` ->
`(begin X)` expansions, but it seems not currently to be a problem;
and, weirdly (?), submodules in a `#lang syndicate` or `#lang
syndicate/actor` module do not seem to inherit the `#%module-begin` of
their container! That is, `(module+ main)`, `(module+ test)` etc. all
seem to have a `racket/base` `#%module-begin`, though I've not looked
very far into this.
Most peculiar on this front is that if the `#,@(reverse final-forms)`
precedes the `(module+ syndicate-main ...)`, and the module being
processed includes, say, a `(module+ main)`, then for some reason the
resulting `main` submodule *is* treated as having a `syndicate/lang`
`#%module-begin` (thus causing problems as suggested in the issue
description)! I *really* don't understand why that might be, and
haven't spent very much time investigating after I noticed that so
long as the `main`-required `syndicate-main` submodule preceded all
other submodule declarations, things seemed to work out.
This whole approach is still a bit dicey: for example, the following
will erroneously treat `(foo quux)` as an expression yielding actions,
rather than a struct declaration:
#lang syndicate
(define-syntax-rule (foo x) (struct x ()))
(foo quux)
2016-07-16 19:40:20 +00:00
|
|
|
module module* module+
|
2016-01-23 23:24:07 +00:00
|
|
|
#%module-begin
|
2016-07-23 15:28:46 +00:00
|
|
|
#%require #%provide
|
|
|
|
begin-for-declarations)))
|
2016-01-23 23:24:07 +00:00
|
|
|
(accumulate-actions action-ids
|
|
|
|
(cons (car forms) final-forms)
|
|
|
|
(cdr forms))
|
|
|
|
(accumulate-action (car forms) action-ids final-forms (cdr forms))))]
|
|
|
|
[non-pair-syntax
|
|
|
|
(accumulate-action (car forms) action-ids final-forms (cdr forms))])))
|
|
|
|
(define (accumulate-action action action-ids final-forms remaining-forms)
|
|
|
|
(define temp (car (generate-temporaries (list action))))
|
|
|
|
(accumulate-actions (cons temp action-ids)
|
2016-07-15 13:50:29 +00:00
|
|
|
(cons #`(define #,temp (capture-actor-actions (lambda () #,action)))
|
|
|
|
final-forms)
|
2016-01-23 23:24:07 +00:00
|
|
|
remaining-forms))
|
|
|
|
(accumulate-actions '() '() (syntax->list #'(forms ...))))]))
|
2016-07-15 13:50:29 +00:00
|
|
|
|
|
|
|
(define (capture-actor-actions thunk)
|
|
|
|
(call-with-syndicate-effects
|
|
|
|
(lambda ()
|
2016-07-28 19:39:52 +00:00
|
|
|
(with-store [(current-pending-actions '())
|
|
|
|
(current-pending-patch patch-empty)]
|
2016-07-15 13:50:29 +00:00
|
|
|
(define result (thunk))
|
|
|
|
(flush-pending-patch!)
|
|
|
|
(cons result (current-pending-actions))))))
|