diff --git a/gib-gab-gob/actors.scm b/gib-gab-gob/actors.scm index bb93e43..804b3de 100644 --- a/gib-gab-gob/actors.scm +++ b/gib-gab-gob/actors.scm @@ -1,5 +1,6 @@ (define-module (gib-gab-gob actors) #:use-module (gib-gab-gob rps) + #:use-module (gib-gab-gob lib) ;; to go into goblins eventually! #:use-module (goblins) #:use-module (goblins actor-lib methods) #:use-module (goblins actor-lib sealers) @@ -37,15 +38,21 @@ (methods [(do-move coords) #f])) -(define (^peer-board bcom) +(define (^peer-board bcom self) ;; Define the array with unspecified values, then fill (define arr (make-array *unspecified* ggg-size ggg-size)) (array-map! arr (lambda () (spawn ^mark))) - (define (_ref x y) (array-ref arr x y)) - (define (_chosen? x y) ($ (_ref x y) 'chosen?)) - - (define (_display) + (methods + [(ref x y) (array-ref arr x y)] + [(chosen? x y) ($ ($ self 'ref x y) 'chosen?)] + [(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) (if ($ mark 'chosen?) "x" " ")) ;; this is .. probably messy? @@ -54,18 +61,7 @@ (lambda (x) (map (lambda (i) (format #t "[~a]" (print-mark i))) (array->list x)) - (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)])) + (format #t "\n")) arr)])) (define* (^mark bcom #:optional [chosen #f]) (methods diff --git a/gib-gab-gob/lib.scm b/gib-gab-gob/lib.scm new file mode 100644 index 0000000..e82d99e --- /dev/null +++ b/gib-gab-gob/lib.scm @@ -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))