Switch to generic action-instruction; actor macro; more work on expand-state
This commit is contained in:
parent
0bf0af74e6
commit
aae15a008b
|
@ -1,6 +1,6 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide ;; actor
|
(provide actor
|
||||||
;; network
|
;; network
|
||||||
;; background
|
;; background
|
||||||
state
|
state
|
||||||
|
@ -60,7 +60,7 @@
|
||||||
|
|
||||||
;; An Instruction is one of
|
;; An Instruction is one of
|
||||||
;; - (patch-instruction Patch (Void -> Instruction))
|
;; - (patch-instruction Patch (Void -> Instruction))
|
||||||
;; - (send-instruction Message (Void -> Instruction))
|
;; - (action-instruction EndpointAction (Void -> Instruction))
|
||||||
;; - (quit-instruction (Option Exn))
|
;; - (quit-instruction (Option Exn))
|
||||||
;; - (spawn-instruction LinkageKind Script (-> Variables) (Void -> Instruction))
|
;; - (spawn-instruction LinkageKind Script (-> Variables) (Void -> Instruction))
|
||||||
;; - (script-complete-instruction Variables)
|
;; - (script-complete-instruction Variables)
|
||||||
|
@ -73,8 +73,8 @@
|
||||||
;; - 'network, a non-blocking, nested, non-exception-linked connection
|
;; - 'network, a non-blocking, nested, non-exception-linked connection
|
||||||
;;
|
;;
|
||||||
;; Patch Instructions are issued when the actor uses `assert!` and
|
;; Patch Instructions are issued when the actor uses `assert!` and
|
||||||
;; `retract!`. Send instructions are issued when the actor uses
|
;; `retract!`. Action instructions are issued when the actor uses
|
||||||
;; `send!`, and quit instructions when `quit!` is called.
|
;; `do!`, and quit instructions when `quit!` is called.
|
||||||
;; Script-complete instructions are automatically issued when a Script
|
;; Script-complete instructions are automatically issued when a Script
|
||||||
;; terminates successfully.
|
;; terminates successfully.
|
||||||
;;
|
;;
|
||||||
|
@ -92,7 +92,7 @@
|
||||||
;; background script, and a self-send to activate it. (TODO))
|
;; background script, and a self-send to activate it. (TODO))
|
||||||
;;
|
;;
|
||||||
(struct patch-instruction (patch k) #:transparent)
|
(struct patch-instruction (patch k) #:transparent)
|
||||||
(struct send-instruction (message k) #:transparent)
|
(struct action-instruction (action k) #:transparent)
|
||||||
(struct quit-instruction (maybe-exn) #:transparent)
|
(struct quit-instruction (maybe-exn) #:transparent)
|
||||||
(struct spawn-instruction (linkage-kind init-script init-variables-fn k)
|
(struct spawn-instruction (linkage-kind init-script init-variables-fn k)
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
@ -175,9 +175,16 @@
|
||||||
(lambda (k) (patch-instruction (patch (matcher-empty) (pattern->matcher #t P)) k))))
|
(lambda (k) (patch-instruction (patch (matcher-empty) (pattern->matcher #t P)) k))))
|
||||||
|
|
||||||
;; Returns void
|
;; Returns void
|
||||||
(define (send! M)
|
(define (send! M) (do! (message M)))
|
||||||
|
|
||||||
|
;; (ActorState -> Transition) -> Void
|
||||||
|
(define (add-endpoint! f)
|
||||||
|
(do! (add-endpoint (lambda (new-eid s) (f s)))))
|
||||||
|
|
||||||
|
;; Returns void
|
||||||
|
(define (do! A)
|
||||||
(call-in-raw-context
|
(call-in-raw-context
|
||||||
(lambda (k) (send-instruction M k))))
|
(lambda (k) (action-instruction A k))))
|
||||||
|
|
||||||
;; Does not return
|
;; Does not return
|
||||||
(define (quit! [maybe-exn #f])
|
(define (quit! [maybe-exn #f])
|
||||||
|
@ -209,6 +216,12 @@
|
||||||
(define-syntax-rule (forever O ...)
|
(define-syntax-rule (forever O ...)
|
||||||
(state [O ...]))
|
(state [O ...]))
|
||||||
|
|
||||||
|
;; Spawn actors with 'actor linkage
|
||||||
|
(define-syntax (actor stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ I ...)
|
||||||
|
(expand-state 'actor #'(I ... (quit!)) #'() #'() #'() #'())]))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Main behavior of HLL actors
|
;; Main behavior of HLL actors
|
||||||
|
|
||||||
|
@ -275,11 +288,11 @@
|
||||||
[pending-patch (if p0 (patch-seq p0 p) p)])
|
[pending-patch (if p0 (patch-seq p0 p) p)])
|
||||||
previous-actions)
|
previous-actions)
|
||||||
(get-next-instr (void)))]
|
(get-next-instr (void)))]
|
||||||
[(send-instruction m get-next-instr)
|
[(action-instruction a get-next-instr)
|
||||||
(handle-actor-syscall (transition (struct-copy actor-state s [pending-patch #f])
|
(handle-actor-syscall (transition (struct-copy actor-state s [pending-patch #f])
|
||||||
(list previous-actions
|
(list previous-actions
|
||||||
(as-endpoint *adhoc-eid* (actor-state-pending-patch s))
|
(as-endpoint *adhoc-eid* (actor-state-pending-patch s))
|
||||||
(message m)))
|
a))
|
||||||
(get-next-instr (void)))]
|
(get-next-instr (void)))]
|
||||||
[(quit-instruction maybe-exn)
|
[(quit-instruction maybe-exn)
|
||||||
(quit #:exception maybe-exn
|
(quit #:exception maybe-exn
|
||||||
|
@ -332,9 +345,12 @@
|
||||||
(for ((edge (syntax->list edges)))
|
(for ((edge (syntax->list edges)))
|
||||||
(printf "~v\n" edge))
|
(printf "~v\n" edge))
|
||||||
|
|
||||||
#`(actor-state (hasheq)
|
#`(spawn! '#,linkage-kind
|
||||||
(vector #,@state-variable-init-exps)))
|
(lambda (vs)
|
||||||
|
#,@init-actions
|
||||||
|
vs)
|
||||||
|
(lambda ()
|
||||||
|
(vector #,@state-variable-init-exps))))
|
||||||
)
|
)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
Loading…
Reference in New Issue