#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)