The Lambda Lab
/
projects
/
sam.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7b73d44
)
Behaviours are now tagged lists.
master
author
Tim Vaughan
<plugd@thelambdalab.xyz>
Thu, 6 May 2021 12:35:41 +0000
(14:35 +0200)
committer
Tim Vaughan
<plugd@thelambdalab.xyz>
Thu, 6 May 2021 12:35:41 +0000
(14:35 +0200)
sam-macros.scm
patch
|
blob
|
history
sam.scm
patch
|
blob
|
history
diff --git
a/sam-macros.scm
b/sam-macros.scm
index
cf4f9ac
..
bbf8ada
100644
(file)
--- a/
sam-macros.scm
+++ b/
sam-macros.scm
@@
-10,7
+10,8
@@
(define-syntax make-beh
(syntax-rules (: => finally)
((make-beh : parent (self) (pat => body ...) ... (finally after ...))
(define-syntax make-beh
(syntax-rules (: => finally)
((make-beh : parent (self) (pat => body ...) ... (finally after ...))
- (cons (lambda (self . message)
+ (list 'beh
+ (lambda (self . message)
(match message
(pat body ...)
...
(match message
(pat body ...)
...
diff --git
a/sam.scm
b/sam.scm
index
c40116d
..
fbe800e
100644
(file)
--- a/
sam.scm
+++ b/
sam.scm
@@
-51,15
+51,20
@@
;; (See also macros defined in sam-macros.scm.)
(define (beh-proc beh)
;; (See also macros defined in sam-macros.scm.)
(define (beh-proc beh)
- (car beh))
+ (ca
d
r beh))
(define (beh-parent beh)
(define (beh-parent beh)
- (cdr beh))
+ (c
ad
dr beh))
(define root-beh
(make-beh : #f (self)
(('ping recipient) =>
(send-message recipient 'pong))))
(define root-beh
(make-beh : #f (self)
(('ping recipient) =>
(send-message recipient 'pong))))
+(define (beh? x)
+ (and (pair? x)
+ (not (null? x))
+ (eq? (car x) 'beh)))
+
;; Actors
(define (make-address host port id)
;; Actors
(define (make-address host port id)
@@
-113,7
+118,7
@@
('pass
(log-trace "Passing to parent behaviour...")
(loop (beh-parent beh)))
('pass
(log-trace "Passing to parent behaviour...")
(loop (beh-parent beh)))
- ((?
procedure
? new-beh) (hash-table-set! actor-table id new-beh))
+ ((?
beh
? new-beh) (hash-table-set! actor-table id new-beh))
(else
'do-nothing)) ; sleep is now the default
(o (exn)
(else
'do-nothing)) ; sleep is now the default
(o (exn)
@@
-222,6
+227,7
@@
(define-beh system-beh
(self)
(define-beh system-beh
(self)
+
(('shutdown) =>
(log-msg "System actor received shutdown message.")
(exit 0)
(('shutdown) =>
(log-msg "System actor received shutdown message.")
(exit 0)