diff --git a/collects/unstable/open-place.rkt b/collects/unstable/open-place.rkt new file mode 100644 index 0000000000..a5e518e293 --- /dev/null +++ b/collects/unstable/open-place.rkt @@ -0,0 +1,28 @@ +#lang racket/base + +(require (for-syntax syntax/parse racket/base syntax/free-vars racket/syntax) + racket/place) + +(provide open-place) + +(define-syntax (open-place stx) + (syntax-parse stx + [(_ ch:id body:expr ...) + (define b #'(let () body ...)) + (define/with-syntax b* (local-expand b 'expression null)) + (define/with-syntax (fvs ...) (free-vars #'b*)) + (define/with-syntax (i ...) (for/list ([(v i) (in-indexed (syntax->list #'(fvs ...)))]) i)) + (define/with-syntax (v p) (generate-temporaries '(v p))) + #'(let () + (define p (place ch (let* ([v (place-channel-get ch)] + [fvs (vector-ref v i)] ...) + b*))) + (define vec (vector fvs ...)) + (for ([e (in-vector vec)] + [n (in-list (syntax->list (quote-syntax (fvs ...))))]) + (unless (place-message-allowed? e) + (raise-arguments-error 'open-place + "free variable values must be allowable as place messages" + (symbol->string (syntax-e n)) e))) + (place-channel-put p vec) + p)])) \ No newline at end of file diff --git a/collects/unstable/scribblings/open-place.scrbl b/collects/unstable/scribblings/open-place.scrbl new file mode 100644 index 0000000000..56406633b6 --- /dev/null +++ b/collects/unstable/scribblings/open-place.scrbl @@ -0,0 +1,21 @@ +#lang scribble/manual +@(require scribble/eval "utils.rkt" + (for-label unstable/open-place racket/place racket/contract racket/base)) + +@(define the-eval (make-base-eval)) +@(the-eval '(require racket/class racket/place unstable/open-place)) + +@title[#:tag "open-place"]{Open @racket[place] expressions} +@unstable-header[] + +@defmodule[unstable/open-place] + +@addition[@author+email["Sam Tobin-Hochstadt" "samth@racket-lang.org"]] + +@defform[(open-place id body ...+)]{ + +Like @racket[(place id body ...)], but @racket[body ...] may have free lexical +variables, which are automatically sent to the newly-created @tech{place}. +Note that these variables must have values accepted by +@racket[place-message-allowed?], otherwise an @[exn:fail:contract] is raised. +} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index fc92018939..82e32f6093 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -93,6 +93,7 @@ Keep documentation and tests up to date. @include-section["logging.scrbl"] @include-section["markparam.scrbl"] @include-section["match.scrbl"] +@include-section["open-place.scrbl"] @include-section["parameter-group.scrbl"] @include-section["pretty.scrbl"] @include-section["recontract.scrbl"]