Update reference to hive to be dynamic state, simplify create-actor.

[8sync.git] / demos / actors / botherbotherbother.scm

diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm
index db3c9d810748e022643c7fa7989d03d2b784bcbe..57b20ff22a78abd9d6b2c685b3073969856d5aab 100755 (executable)
--- a/demos/actors/botherbotherbother.scm
+++ b/demos/actors/botherbotherbother.scm
@@ -3,7 +3,7 @@
 !#
 
 ;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright (C) 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of 8sync.
 ;;;
@@ -22,11 +22,11 @@
 
 ;; Puppet show simulator.
 
-(use-modules (8sync agenda)
-             (8sync systems actors)
+(use-modules (8sync actors)
              (oop goops)
              (ice-9 hash-table)
-             (ice-9 format))
+             (ice-9 format)
+             (fibers conditions))
 
 (set! *random-state* (random-state-from-platform))
 (define (random-choice lst)
@@ -46,41 +46,36 @@
       (format #f "~a-~a" student current-number))))
 
 
-(define-class <student> (<actor>)
+(define-actor <student> (<actor>)
+  ((bother-professor
+    (lambda* (actor message #:key target)
+      "Go bother a professor"
+      (while (not (student-dead actor))
+        (format #t "~a: Bother bother bother!\n"
+                (actor-id-actor actor))
+        (<- target 'be-bothered
+            #:noise "Bother bother bother!\n"))))
+
+   (be-lambda-consvardraed
+    (lambda (actor message)
+      "This kills the student."
+      (format #t "~a says: AAAAAAAHHHH!!! I'm dead!\n"
+              (actor-id-actor actor))
+      (set! (student-dead actor) #t))))
   (name #:init-keyword #:name)
   (dead #:init-value #f
-        #:accessor student-dead)
-  (message-handler
-   #:init-value
-   (make-action-dispatch
-    (bother-professor
-     (lambda (actor message)
-       "Go bother a professor"
-       (while (not (student-dead actor))
-         (format #t "~a: Bother bother bother!\n"
-                 (actor-id-actor actor))
-         (send-message
-          actor (message-ref message 'target)
-          'be-bothered
-          #:noise "Bother bother bother!\n"))))
-
-    (be-lambda-consvardraed
-     (lambda (actor message)
-       "This kills the student."
-       (format #t "~a says: AAAAAAAHHHH!!! I'm dead!\n"
-               (actor-id-actor actor))
-       (set! (student-dead actor) #t))))))
+        #:accessor student-dead))
 
 (define complaints
   '("Hey!" "Stop that!" "Oof!"))
 
-(define (professor-be-bothered actor message)
+(define (professor-be-bothered actor message . rest)
   (define whos-bothering (professor-bothered-by actor))
-
   (hash-set! whos-bothering (message-from message) #t)
 
   ;; Oof!  Those kids!
   (display (string-append (random-choice complaints)))
+  (newline)
 
   ;; More than one student is bothering us, lose our temper
   (if (> (hash-count (const #t) whos-bothering)
@@ -90,47 +85,44 @@
                 (actor-id actor))
         (hash-for-each
          (lambda (student _)
-           (send-message
-            actor student
-            'be-lambda-consvardraed)
+           (<- student 'be-lambda-consvardraed)
            ;; Remove student from bothering list
            (hash-remove! whos-bothering student))
          whos-bothering))
       ;; Otherwise, remove them from the list and carry on
       (hash-remove! whos-bothering (message-from message))))
 
-(define-class <professor> (<actor>)
+(define-actor <professor> (<actor>)
+  ((be-bothered professor-be-bothered))
   ;; This value checks whether any other actor is currently
   ;; bothering this same character.
   ;; We'll use a hash table as a fake set.
   (bothered-by #:init-thunk make-hash-table
-               #:getter professor-bothered-by)
-  (message-handler
-   #:init-value
-   (make-action-dispatch
-    (be-bothered professor-be-bothered))))
+               #:getter professor-bothered-by))
 
 (define num-students 10)
 
 (define (main . args)
-  (define agenda (make-agenda))
-  (define hive (make-hive))
-  (define professor (hive-create-actor* hive <professor> "prof"))
-  (define namegen (student-name-generator))
-  (define students
-    (map
-     (lambda _
-       (let ((name (namegen)))
-         (hive-create-actor* hive <student> name
-                             #:name name)))
-     (iota num-students)))
-
-  ;; Bootstrap each student into bothering-professor mode.
-  (define start-bothering-tasks
-    (map
-     (lambda (student)
-       (bootstrap-message hive student 'bother-professor
-                               #:target professor))
-     students))
-
-  (ez-run-hive hive start-bothering-tasks))
+  (run-hive
+   (lambda (hive)
+     (define professor (create-actor* <professor> "prof"))
+     (define namegen (student-name-generator))
+     (define students
+       (map
+        (lambda _
+          (let ((name (namegen)))
+            (create-actor* <student> name
+                           #:name name)))
+        (iota num-students)))
+
+     ;; Bootstrap each student into bothering-professor mode.
+     (define start-bothering-tasks
+       (map
+        (lambda (student)
+          (<- student 'bother-professor
+              #:target professor))
+        students))
+
+     (run-hive hive start-bothering-tasks)
+     ;; in other words, this program doesn't really halt
+     (wait (make-condition)))))