fizzbuzz

お正月なのでてきとーに。

(use srfi-42)
(use srfi-1)

(define-class <fb> ()
  ((default :init-keyword :default)
   (word :init-keyword :word)))

(define (make-fb i)
  (make <fb> :default i :word ""))

(define-method add ((self <fb>) (i <integer>))
  (cond [(= (slot-ref self 'default) i) self]
        [else (error "number value pair is not matched")]))

(define-method add ((self <fb>) (str <string>))
  (let1 word* (string-append (slot-ref self 'word) str)
    (slot-set! self 'word word*))
  self)

(define (join fn)
  (lambda (knil . xs)
    (fold (lambda (x knil*) (fn knil* x)) knil xs)))

(define-method write-object ((self <fb>) port)
  (let* ((word (slot-ref self 'word))
         (v (if (string=? word "") (slot-ref self 'default) word)))
    (format port "~a" v)))

(define (fizz-buzz n)
  (map (cute (join add) <...>)
       (list-ec (: i 1 n) (make-fb i))
       (list-ec (: i 1 n) (if (zero? (modulo i 3)) "fizz" ""))
       (list-ec (: i 1 n) (if (zero? (modulo i 5)) "buzz" ""))))

実行結果

(make-fb 1) ; => 1
(add (make-fb 3) "fizz") ; => fizz
(add (make-fb 5) "buzz") ; => buzz
((join add) (make-fb 10) "fizz" "buzz") ; => fizzbuzz

(fizz-buzz 20) ; => (1 2 fizz 4 buzz fizz 7 8 fizz buzz 11 fizz 13 14 fizzbuzz 16 17 fizz 19)