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

remember initial state when compiling

This commit is contained in:
Sam Caldwell 2019-03-22 16:08:36 -04:00
parent a8d398eec7
commit 126046caa9
1 changed files with 22 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
racket/typed/proto.rkt
View File

@ -137,7 +137,12 @@
;; and each facet's parent. The parent of the root facet is #f. ;; and each facet's parent. The parent of the root facet is #f.
(struct facet-tree (down up) #:transparent) (struct facet-tree (down up) #:transparent)
;; Role -> (Hashof StateName State) ;; a RoleGraph is a
;; (role-graph StateName (Hashof StateName State))
;; describing the initial state and the behavior in each state.
(struct role-graph (st0 states) #:transparent)
;; Role -> RoleGraph
;; in each state, the transitions will include the reactions of the parent ;; in each state, the transitions will include the reactions of the parent
;; facet(s) ;; facet(s)
(define (compile role) (define (compile role)
@ -170,12 +175,15 @@
(loop (append more new-work) (loop (append more new-work)
(hash-set states current (state current transitions)))] (hash-set states current (state current transitions)))]
['() ['()
states]))) (role-graph (set (Role-nm role)) states)])))
(module+ test (module+ test
(test-case (test-case
"compile seller" "compile seller"
(define seller# (compile seller)) (define rg (compile seller))
(check-true (role-graph? rg))
(match-define (role-graph sn0 seller#) rg)
(check-equal? sn0 (set 'seller))
(check-true (hash-has-key? seller# (set 'seller))) (check-true (hash-has-key? seller# (set 'seller)))
(check-true (hash-has-key? seller# (set 'seller 'fulfill))) (check-true (hash-has-key? seller# (set 'seller 'fulfill)))
(check-equal? (hash-keys seller#) (check-equal? (hash-keys seller#)
@ -194,7 +202,11 @@
(Role 'x (Role 'x
(list (Reacts (Know Int) (list (Reacts (Know Int)
(Stop 'x '()))))) (Stop 'x '())))))
(define state# (compile r)) (define rg (compile r))
(check-true (role-graph? rg))
(match-define (role-graph sn0 state#) rg)
(check-equal? sn0
(set 'x))
(check-true (hash-has-key? state# (set))) (check-true (hash-has-key? state# (set)))
(check-true (hash-has-key? state# (set 'x))) (check-true (hash-has-key? state# (set 'x)))
(define state0 (hash-ref state# (set 'x))) (define state0 (hash-ref state# (set 'x)))
@ -544,11 +556,12 @@
(module+ vis (module+ vis
;; TODO - for now, assume there are no names that need escaping ;; TODO - for now, assume there are no names that need escaping
;; (Hashof StateName State) -> DotString ;; RoleGraph -> DotString
;; name is an optional string ;; name is an optional string
;; translate the states to DOT that can be passed to graphviz ;; translate the states to DOT that can be passed to graphviz
(define (render st# (define (render rg
#:name [name #f]) #:name [name #f])
(match-define (role-graph st0 st#) rg)
(define graph-name (or name "Roles")) (define graph-name (or name "Roles"))
(define edges (define edges
(for/list ([(sn st) (in-hash st#)]) (for/list ([(sn st) (in-hash st#)])
@ -564,12 +577,12 @@
#:before-first (format "digraph ~a {\n" graph-name) #:before-first (format "digraph ~a {\n" graph-name)
#:after-last "\n}")) #:after-last "\n}"))
;; (Hashof StateName State) PathString -> DotString ;; RoleGraph PathString -> DotString
;; Like render but write the output to a file ;; Like render but write the output to a file
(define (render-to-file st# dest (define (render-to-file rg dest
#:name [name #f]) #:name [name #f])
(with-output-to-file dest (with-output-to-file dest
(lambda () (write-string (render st#))) (lambda () (write-string (render rg)))
#:exists 'replace)) #:exists 'replace))
;; StateName -> String ;; StateName -> String