Added selfish spawner to clean code up!
This commit is contained in:
parent
598ac34998
commit
ecd912e50d
2 changed files with 31 additions and 17 deletions
|
@ -1,5 +1,6 @@
|
||||||
(define-module (gib-gab-gob actors)
|
(define-module (gib-gab-gob actors)
|
||||||
#:use-module (gib-gab-gob rps)
|
#:use-module (gib-gab-gob rps)
|
||||||
|
#:use-module (gib-gab-gob lib) ;; to go into goblins eventually!
|
||||||
#:use-module (goblins)
|
#:use-module (goblins)
|
||||||
#:use-module (goblins actor-lib methods)
|
#:use-module (goblins actor-lib methods)
|
||||||
#:use-module (goblins actor-lib sealers)
|
#:use-module (goblins actor-lib sealers)
|
||||||
|
@ -37,15 +38,21 @@
|
||||||
(methods
|
(methods
|
||||||
[(do-move coords) #f]))
|
[(do-move coords) #f]))
|
||||||
|
|
||||||
(define (^peer-board bcom)
|
(define (^peer-board bcom self)
|
||||||
;; Define the array with unspecified values, then fill
|
;; Define the array with unspecified values, then fill
|
||||||
(define arr (make-array *unspecified* ggg-size ggg-size))
|
(define arr (make-array *unspecified* ggg-size ggg-size))
|
||||||
(array-map! arr (lambda () (spawn ^mark)))
|
(array-map! arr (lambda () (spawn ^mark)))
|
||||||
|
|
||||||
(define (_ref x y) (array-ref arr x y))
|
(methods
|
||||||
(define (_chosen? x y) ($ (_ref x y) 'chosen?))
|
[(ref x y) (array-ref arr x y)]
|
||||||
|
[(chosen? x y) ($ ($ self 'ref x y) 'chosen?)]
|
||||||
(define (_display)
|
[(choose! x y)
|
||||||
|
(if ($ self 'chosen? x y)
|
||||||
|
(error "coords already chosen:" x y)
|
||||||
|
(begin
|
||||||
|
($ ($ self 'ref x y) 'choose!)
|
||||||
|
($ self 'display)))]
|
||||||
|
[(display)
|
||||||
(define (print-mark mark)
|
(define (print-mark mark)
|
||||||
(if ($ mark 'chosen?) "x" " "))
|
(if ($ mark 'chosen?) "x" " "))
|
||||||
;; this is .. probably messy?
|
;; this is .. probably messy?
|
||||||
|
@ -54,18 +61,7 @@
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(map (lambda (i) (format #t "[~a]" (print-mark i)))
|
(map (lambda (i) (format #t "[~a]" (print-mark i)))
|
||||||
(array->list x))
|
(array->list x))
|
||||||
(format #t "\n")) arr))
|
(format #t "\n")) arr)]))
|
||||||
|
|
||||||
(methods
|
|
||||||
[(ref x y) (_ref x y)]
|
|
||||||
[(chosen? x y) (_chosen? x y)]
|
|
||||||
[(choose! x y)
|
|
||||||
(if (_chosen? x y)
|
|
||||||
(error "coords already chosen:" x y)
|
|
||||||
(begin
|
|
||||||
($ (_ref x y) 'choose!)
|
|
||||||
(_display)))]
|
|
||||||
[(display) (_display)]))
|
|
||||||
|
|
||||||
(define* (^mark bcom #:optional [chosen #f])
|
(define* (^mark bcom #:optional [chosen #f])
|
||||||
(methods
|
(methods
|
||||||
|
|
18
gib-gab-gob/lib.scm
Normal file
18
gib-gab-gob/lib.scm
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
(define-module (gib-gab-gob lib)
|
||||||
|
#:use-module (goblins)
|
||||||
|
#:export (selfish-spawn))
|
||||||
|
|
||||||
|
(define (selfish-spawn constructor . args)
|
||||||
|
|
||||||
|
(define (^selfish bcom)
|
||||||
|
(lambda (self)
|
||||||
|
(bcom (apply constructor bcom self args))))
|
||||||
|
|
||||||
|
(let ((name (procedure-property constructor 'name)))
|
||||||
|
(set-procedure-property! ^selfish 'name name))
|
||||||
|
|
||||||
|
(let ((self (spawn ^selfish)))
|
||||||
|
(pk self)
|
||||||
|
;; now transition to the version with self
|
||||||
|
($ self self)
|
||||||
|
self))
|
Loading…
Reference in a new issue