!#
;;; 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.
;;;
;; 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)
(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)
- (actions #:allocation #:each-subclass
- #:init-value
- (build-actions
- (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))
- (<- 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))))))
+ #:accessor student-dead))
(define complaints
'("Hey!" "Stop that!" "Oof!"))
(actor-id actor))
(hash-for-each
(lambda (student _)
- (<- 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)
- (actions #:allocation #:each-subclass
- #:init-value
- (build-actions
- (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)))))