fizzbuzz/fizzbuzz.rkt

#lang racket

(define (skip s)
   s)

(define (halt s)
   "")

(define (myprint s x)
   (string-append s x))

(define (base n)
   (lambda (k)
      (lambda (s)
         (k (myprint (number->string n) s)))))

(define (mult n)
  (lambda (k) (= 0 (modulo k n))))

(require (for-syntax syntax/parse racket/base))

(begin-for-syntax
   (define-syntax-class fbline
      #:description "predicate string pair"
      (pattern (p:expr m:string))))

(define-syntax (create-trigger stx)
   (syntax-parse stx
      [(_ p:expr m:string)
         #'(lambda (n)
              (lambda (k)
                 (lambda (s)
                    (if (p n)
                        (myprint m (k (halt s)))
                        (k s)))))]))

(define-syntax (define-fizzbuzz stx)
   (syntax-parse stx
      [(_ name:identifier l:fbline ...)
         #'(define (name n)
             (((compose (base n)
                        ((create-trigger l.p l.m) n) ...)
               skip) ""))]))

(define-fizzbuzz fizzbuzz
   [(mult 3) "Fizz"]
   [(mult 5) "Buzz"])

(provide mult define-fizzbuzz fizzbuzz)