Switch to generic action-instruction; actor macro; more work on expand-state

This commit is contained in:
Tony Garnock-Jones 2015-12-03 13:31:36 -08:00
parent 0bf0af74e6
commit aae15a008b
1 changed files with 28 additions and 12 deletions

View File

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