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

Steps toward proper scoping of #:collect bindings

This commit is contained in:
Tony Garnock-Jones 2015-12-11 20:25:17 +13:00
parent c607f1c53f
commit 122ea7ea1c
1 changed files with 36 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
prospect/actor.rkt
View File

@ -63,7 +63,7 @@
;; An Aggregates is a (Hashtable Nat Any), storing implicit state of ;; An Aggregates is a (Hashtable Nat Any), storing implicit state of
;; an actor, including tracked and implicit aggregates. ;; an actor, including tracked and implicit aggregates.
;; A Script is a (Variables -> Variables). It is to be executed inside ;; A Script is a (-> Variables). It is to be executed inside
;; the special syndicate-hll prompt, and so may have Instruction ;; the special syndicate-hll prompt, and so may have Instruction
;; side-effects. ;; side-effects.
@ -312,7 +312,7 @@
(define (run-script s script) (define (run-script s script)
(handle-actor-syscall (transition s '()) (handle-actor-syscall (transition s '())
((reply-to (lambda (dummy) ((reply-to (lambda (dummy)
(define new-variables (script (actor-state-variables s))) (define new-variables (script))
(call-in-raw-context/abort (call-in-raw-context/abort
(lambda () (lambda ()
(script-complete-instruction new-variables))))) (script-complete-instruction new-variables)))))
@ -424,16 +424,18 @@
(define (mapply v fs) (map (lambda (f) (f v)) fs)) (define (mapply v fs) (map (lambda (f) (f v)) fs))
(define (make-run-script-call state-stx I-stxs) (define (make-run-script-call outer-expr-stx state-stx I-stxs)
(if (zero? binding-count) (cond
#`(run-script #,state-stx (match-lambda [(zero? binding-count)
[(vector) #`(run-script #,state-stx (lambda ()
#,@I-stxs #,@I-stxs
(vector)])) (vector)))]
#`(run-script #,state-stx (match-lambda [(stx-null? I-stxs)
[(vector #,@binding-names) (raise-syntax-error #f "Empty expression sequence not permitted" outer-expr-stx I-stxs)]
(call-with-values (lambda () #,@I-stxs) [else
vector)])))) #`(run-script #,state-stx (lambda ()
(call-with-values (lambda () #,@I-stxs)
vector)))]))
(define (add-assertion-maintainer! endpoint-index (define (add-assertion-maintainer! endpoint-index
assert-stx assert-stx
@ -479,8 +481,11 @@
#'(patch-added p) #'(patch-added p)
#'(patch-removed p)) #'(patch-removed p))
proj)))] proj)))]
(match-define (list #,@bindings) entry) (lambda (s)
(lambda (s) #,(make-run-script-call #'s I-stxs))))] (match (actor-state-variables s)
[(vector #,@binding-names)
(match-define (list #,@bindings) entry)
#,(make-run-script-call outer-expr-stx #'s I-stxs)]))))]
[_ #f])))))) [_ #f]))))))
(define (prepend-at-meta-stx stx level) (define (prepend-at-meta-stx stx level)
@ -494,10 +499,12 @@
(add-event-handler! (add-event-handler!
(lambda (evt-stx) (lambda (evt-stx)
#`(lambda (s) #`(lambda (s)
(match #,evt-stx (match (actor-state-variables s)
[(message #,(prepend-at-meta-stx match-pat (syntax-e L-stx))) [(vector #,@binding-names)
#,(make-run-script-call #'s I-stxs)] (match #,evt-stx
[_ #f]))))) [(message #,(prepend-at-meta-stx match-pat (syntax-e L-stx)))
#,(make-run-script-call outer-expr-stx #'s I-stxs)]
[_ #f])])))))
(define (analyze-event! index E-stx I-stxs) (define (analyze-event! index E-stx I-stxs)
(syntax-parse E-stx (syntax-parse E-stx
@ -514,6 +521,7 @@
(add-event-handler! (add-event-handler!
(lambda (evt-stx) (lambda (evt-stx)
#`(lambda (s) #`(lambda (s)
(match-define (vector #,@binding-names) (actor-state-variables s))
(define old-val (hash-ref (actor-state-aggregates s) #,aggregate-index)) (define old-val (hash-ref (actor-state-aggregates s) #,aggregate-index))
(define new-val Pred) (define new-val Pred)
(if (eq? old-val new-val) (if (eq? old-val new-val)
@ -523,7 +531,7 @@
#,aggregate-index #,aggregate-index
new-val)]))) new-val)])))
(if new-val (if new-val
#,(make-run-script-call #'s I-stxs) #,(make-run-script-call E-stx #'s I-stxs)
(transition s '())))))))])) (transition s '())))))))]))
(define (analyze-assertion! index Pred-stx outer-expr-stx P-stx L-stx) (define (analyze-assertion! index Pred-stx outer-expr-stx P-stx L-stx)
@ -608,9 +616,15 @@
((extend-pending-patch *linkage-label* initial-subs) s)) ((extend-pending-patch *linkage-label* initial-subs) s))
(define (run-init-actions s) (define (run-init-actions s)
(run-script s (lambda (vs) (match (actor-state-variables s)
#,@init-actions [(vector #,@binding-names)
vs))) ;; TODO: At the moment we are *not* letting the
;; init-actions update the variables. Is this the
;; right thing?
;; TODO: what about intermediate (state)s? How are the variables updated?
(run-script s (lambda ()
#,@init-actions
(vector #,@binding-names)))]))
(list behavior (list behavior
(sequence-transitions0 initial-state (sequence-transitions0 initial-state