syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Move box-protocol to a #lang preserves-schema module

This commit is contained in:
Tony Garnock-Jones 2021-06-03 23:22:46 +02:00
parent d554c4ba8e
commit b49178146d
6 changed files with 41 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
syndicate/schemas/box-protocol.prs → syndicate-examples/speed-tests/box-and-client/protocol.rkt
View File

@ -1,5 +1,6 @@
#lang preserves-schema #:plugin syndicate/schema-compiler
version 1 .
embeddedType Actor.Ref .
BoxState = <BoxState @value int>.
SetBox = <SetBox @value int>.

15
syndicate-examples/speed-tests/box-and-client/stats.rkt Normal file
View File

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

18
syndicate-examples/speed-tests/box-and-client-with-dataspace.rkt → syndicate-examples/speed-tests/box-and-client/with-dataspace.rkt
View File

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

13
syndicate-examples/speed-tests/box-and-client-without-dataspace.rkt → syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt
View File

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

13
syndicate/private/install.rkt
View File

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

15
syndicate/schema-compiler.rkt
View File

@ -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?