diff --git a/racket/info.rkt b/racket/info.rkt index df49c59..2dd3de9 100644 --- a/racket/info.rkt +++ b/racket/info.rkt @@ -13,6 +13,7 @@ "gui-lib" "pict-lib" "sgl" + "struct-defaults" )) (define build-deps '("racket-doc" "scribble-lib")) diff --git a/racket/syndicate/drivers/web.rkt b/racket/syndicate/drivers/web.rkt index a24fe46..ec453b8 100644 --- a/racket/syndicate/drivers/web.rkt +++ b/racket/syndicate/drivers/web.rkt @@ -11,7 +11,9 @@ (struct-out web-response-header) (struct-out web-response-complete) (struct-out web-response-chunked) - (struct-out web-response-websocket) + + (rename-out [web-response-websocket ]) + (struct-out/defaults [make-web-response-websocket web-response-websocket]) (struct-out web-response-chunk) (struct-out websocket-message) @@ -38,6 +40,7 @@ (require web-server/private/connection-manager) (require (only-in web-server/private/util lowercase-symbol!)) (require web-server/dispatchers/dispatch) +(require struct-defaults) (require/activate "timer.rkt") @@ -57,6 +60,10 @@ (struct web-response-chunk (id bytes) #:prefab) (struct websocket-message (id direction body) #:prefab) +(begin-for-declarations + (define-struct-defaults make-web-response-websocket web-response-websocket + (#:headers [web-response-websocket-headers '()]))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Ground-level communication messages diff --git a/racket/syndicate/examples/actor/web-sanity-check.rkt b/racket/syndicate/examples/actor/web-sanity-check.rkt index 89f4975..34bbae9 100644 --- a/racket/syndicate/examples/actor/web-sanity-check.rkt +++ b/racket/syndicate/examples/actor/web-sanity-check.rkt @@ -22,7 +22,7 @@ ($ req (web-request-header _ (web-resource vh `("ws" ())) _ _)) _)) (actor (react - (assert (web-response-websocket id '())) + (assert (web-response-websocket id)) (stop-when (retracted (observe (websocket-message id 'outbound _))) (log-info "Connection dropped")) (stop-when (message (websocket-message id 'inbound "quit")) diff --git a/racket/syndicate/lang.rkt b/racket/syndicate/lang.rkt index c86b47b..bde4f0a 100644 --- a/racket/syndicate/lang.rkt +++ b/racket/syndicate/lang.rkt @@ -10,6 +10,7 @@ activate require/activate current-ground-dataspace + begin-for-declarations (except-out (all-from-out racket/base) #%module-begin sleep) (all-from-out racket/match) (all-from-out "main.rkt") @@ -31,6 +32,9 @@ (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) @@ -60,7 +64,9 @@ final-stx) (syntax-case (local-expand (car forms) 'module - (cons #'module+ (kernel-form-identifier-list))) () + (append (list #'module+ + #'begin-for-declarations) + (kernel-form-identifier-list))) () [(head rest ...) (if (free-identifier=? #'head #'begin) (accumulate-actions action-ids @@ -70,7 +76,8 @@ (syntax->list #'(define-values define-syntaxes begin-for-syntax module module* module+ #%module-begin - #%require #%provide))) + #%require #%provide + begin-for-declarations))) (accumulate-actions action-ids (cons (car forms) final-forms) (cdr forms))