From b49178146dc9b8fd994d05dada5ac24683b866dd Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 3 Jun 2021 23:22:46 +0200 Subject: [PATCH] Move box-protocol to a #lang preserves-schema module --- .../speed-tests/box-and-client/protocol.rkt | 3 ++- .../speed-tests/box-and-client/stats.rkt | 15 +++++++++++++++ .../with-dataspace.rkt} | 18 +++--------------- .../without-dataspace.rkt} | 13 +------------ syndicate/private/install.rkt | 13 ++++++++----- syndicate/schema-compiler.rkt | 15 ++++++++++++--- 6 files changed, 41 insertions(+), 36 deletions(-) rename syndicate/schemas/box-protocol.prs => syndicate-examples/speed-tests/box-and-client/protocol.rkt (77%) create mode 100644 syndicate-examples/speed-tests/box-and-client/stats.rkt rename syndicate-examples/speed-tests/{box-and-client-with-dataspace.rkt => box-and-client/with-dataspace.rkt} (57%) rename syndicate-examples/speed-tests/{box-and-client-without-dataspace.rkt => box-and-client/without-dataspace.rkt} (80%) diff --git a/syndicate/schemas/box-protocol.prs b/syndicate-examples/speed-tests/box-and-client/protocol.rkt similarity index 77% rename from syndicate/schemas/box-protocol.prs rename to syndicate-examples/speed-tests/box-and-client/protocol.rkt index d200d54..3896e4e 100644 --- a/syndicate/schemas/box-protocol.prs +++ b/syndicate-examples/speed-tests/box-and-client/protocol.rkt @@ -1,5 +1,6 @@ +#lang preserves-schema #:plugin syndicate/schema-compiler + version 1 . -embeddedType Actor.Ref . BoxState = . SetBox = . diff --git a/syndicate-examples/speed-tests/box-and-client/stats.rkt b/syndicate-examples/speed-tests/box-and-client/stats.rkt new file mode 100644 index 0000000..10e3c38 --- /dev/null +++ b/syndicate-examples/speed-tests/box-and-client/stats.rkt @@ -0,0 +1,15 @@ +#lang racket/base + +(provide report-stats) + +(define (report-stats REPORT_EVERY) + (define start-time (current-inexact-milliseconds)) + (define prev-value 0) + (lambda (new-value) + (when (zero? (remainder new-value REPORT_EVERY)) + (define end-time (current-inexact-milliseconds)) + (define delta (/ (- end-time start-time) 1000.0)) + (define count (- new-value prev-value)) + (set! prev-value new-value) + (set! start-time end-time) + (log-info "Box got ~a (~a Hz)" new-value (/ count delta))))) diff --git a/syndicate-examples/speed-tests/box-and-client-with-dataspace.rkt b/syndicate-examples/speed-tests/box-and-client/with-dataspace.rkt similarity index 57% rename from syndicate-examples/speed-tests/box-and-client-with-dataspace.rkt rename to syndicate-examples/speed-tests/box-and-client/with-dataspace.rkt index 3c0d8b3..31ca547 100644 --- a/syndicate-examples/speed-tests/box-and-client-with-dataspace.rkt +++ b/syndicate-examples/speed-tests/box-and-client/with-dataspace.rkt @@ -1,30 +1,18 @@ #lang syndicate -(require syndicate/schemas/gen/box-protocol) - -(define (report-stats REPORT_EVERY) - (define start-time (current-inexact-milliseconds)) - (define prev-value 0) - (lambda (new-value) - (when (zero? (remainder new-value REPORT_EVERY)) - (define end-time (current-inexact-milliseconds)) - (define delta (/ (- end-time start-time) 1000.0)) - (define count (- new-value prev-value)) - (set! prev-value new-value) - (set! start-time end-time) - (log-info "Box got ~a (~a Hz)" new-value (/ count delta))))) +(require "protocol.rkt") +(require "stats.rkt") (define box (action (ds LIMIT REPORT_EVERY) (spawn #:name 'box - (define root-facet this-facet) (define-field value 0) (define reporter (report-stats REPORT_EVERY)) (at ds (assert (BoxState (value))) (when (message (SetBox $new-value)) (reporter new-value) - (when (= new-value LIMIT) (stop-facet root-facet)) + (when (= new-value LIMIT) (stop-current-facet)) (value new-value)))))) (define client diff --git a/syndicate-examples/speed-tests/box-and-client-without-dataspace.rkt b/syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt similarity index 80% rename from syndicate-examples/speed-tests/box-and-client-without-dataspace.rkt rename to syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt index 74a62a2..372440b 100644 --- a/syndicate-examples/speed-tests/box-and-client-without-dataspace.rkt +++ b/syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt @@ -1,16 +1,6 @@ #lang syndicate -(define (report-stats REPORT_EVERY) - (define start-time (current-inexact-milliseconds)) - (define prev-value 0) - (lambda (new-value) - (when (zero? (remainder new-value REPORT_EVERY)) - (define end-time (current-inexact-milliseconds)) - (define delta (/ (- end-time start-time) 1000.0)) - (define count (- new-value prev-value)) - (set! prev-value new-value) - (set! start-time end-time) - (log-info "Box got ~a (~a Hz)" new-value (/ count delta))))) +(require "stats.rkt") (define box (action (k LIMIT REPORT_EVERY) @@ -26,7 +16,6 @@ 'setter (ref (entity #:message (action (new-value) - ;; (log-info "new-value ~v" new-value) (reporter new-value) (when (= new-value LIMIT) (stop-facet root-facet)) (value new-value))))))))) diff --git a/syndicate/private/install.rkt b/syndicate/private/install.rkt index a73d28c..1a859cc 100644 --- a/syndicate/private/install.rkt +++ b/syndicate/private/install.rkt @@ -6,15 +6,18 @@ (require preserves-schema/bin/preserves-schema-rkt) (require (only-in racket/file delete-directory/files)) -(require (only-in "../schema-compiler.rkt" schema-compiler-plugin)) +(require (only-in "../schema-compiler.rkt" + schema-compiler-plugin + schema-compiler-plugin-mode)) (define (pre-installer _collects-path syndicate-path) (define output-directory (build-path syndicate-path "schemas/gen")) (delete-directory/files output-directory #:must-exist? #f) - (batch-compile #:inputs (list (build-path syndicate-path "schemas/**.prs")) - #:additional-modules (hash '(Actor) 'syndicate/actor) - #:output-directory output-directory - #:plugins (list schema-compiler-plugin))) + (parameterize ((schema-compiler-plugin-mode 'meta)) + (batch-compile #:inputs (list (build-path syndicate-path "schemas/**.prs")) + #:additional-modules (hash '(Actor) 'syndicate/actor) + #:output-directory output-directory + #:plugins (list schema-compiler-plugin)))) (define-runtime-path syndicate-path "..") (define (regenerate!) diff --git a/syndicate/schema-compiler.rkt b/syndicate/schema-compiler.rkt index 0571b0f..c94d131 100644 --- a/syndicate/schema-compiler.rkt +++ b/syndicate/schema-compiler.rkt @@ -1,6 +1,7 @@ #lang racket/base -(provide schema-compiler-plugin) +(provide schema-compiler-plugin + schema-compiler-plugin-mode) (require racket/pretty) (require racket/match) @@ -12,12 +13,20 @@ (require preserves-schema/type) (require preserves-schema/gen/schema) +(define schema-compiler-plugin-mode (make-parameter 'normal)) + (define (schema-compiler-plugin schema options) (match-define (schema-compiler-options _name lookup-module-path paths) options) - (define ds-path (lookup-module-path '(dataspace-patterns))) - (define meta? (equal? ds-path (schema-translation-paths-relative-output-path paths))) + (define ds-path + (match (schema-compiler-plugin-mode) + ['normal 'syndicate/schemas/gen/dataspace-patterns] + ['meta (lookup-module-path '(dataspace-patterns))])) + (define meta? + (match (schema-compiler-plugin-mode) + ['normal #f] + ['meta (equal? ds-path (schema-translation-paths-relative-output-path paths))])) (define (N sym) (if meta?