#!/usr/local/bin/guile-oops \
-e main -s
!#
;;; $Id: methcall.guile,v 1.4 2001/05/27 17:33:15 doug Exp $
;;; http://www.bagley.org/~doug/shootout/
;;; from: Benedikt Rosenau
(use-modules (oop goops))
(define-method (print-bool (b <boolean>))
(display (if b "true\n" "false\n")))
(define-class <toggle> ()
(state #:getter value? #:init-keyword #:state))
(define-class <nth-toggle> (<toggle>)
(count-max #:init-keyword #:count-max)
(counter #:init-value 0))
(define-method (activate! (t <toggle>))
(slot-set! t 'state (not (slot-ref t 'state)))
t)
(define-method (activate! (n-t <nth-toggle>))
(let ((counter (+ 1 (slot-ref n-t 'counter))))
(slot-set! n-t 'counter counter)
(if (>= counter (slot-ref n-t 'count-max))
(begin (slot-set! n-t 'state (not (slot-ref n-t 'state)))
(slot-set! n-t 'counter 0)))
n-t))
(define-method (main (l <list>))
(let ((n (catch #t (lambda () (string->number (cadr l)))
(lambda ex 1))))
(let ((tog (make <toggle> #:state #t)))
(do ((i 1 (+ i 1))) ((= i n))
(value? (activate! tog)))
(print-bool (value? (activate! tog))))
(let ((ntog (make <nth-toggle> #:state #t #:count-max 3)))
(do ((i 1 (+ i 1))) ((= i n))
(value? (activate! ntog)))
(print-bool (value? (activate! ntog))))))