Optimizing FizzBuzz generators for Common Lisp

cl-fizzbuzz.lisp

#+quicklisp
(ql:quickload :alexandria)

(defpackage #:fizzbuzz
  (:use #:cl #:alexandria)
  (:export #:make-fizzbuzz-counter-from-rules
           #:define-fizzbuzz-counter-from-rules
           #:print-fizzbuzz
           #:print-fizzbuzz*
           #:fizzbuzz
           #:fizzbuzzquuxquazbasil))

(in-package #:fizzbuzz)

(eval-when (:compile-toplevel :execute)
  (defun make-fizzbuzz-counter-from-rules (rules)
    "Ingests RULES and returns a FizzBuzz counter, an object encoding a set of
FizzBuzz rules in an unspecified format.

RULES is a list of lists, with each element list having the form (NUM STRING).
The list is interpreted into a FizzBuzz problem as follows: Given an input
number X, print each STRING for which it is true that the corresponding NUM
divides X, with no separators in between and in the order provided by RULES.
Then, if no STRING is output this way, output X.

In other words, the RULES list for the canonical FizzBuzz problem would be:
'((3 \"Fizz\") (5 \"Buzz\"))"
    (assert (proper-list-p rules))
    (assert (every (lambda (rule)
                     (and (proper-list-p rule)
                          (= (proper-list-length rule) 2)
                          (integerp (first rule))
                          (plusp (first rule))
                          (stringp (second rule))))
                   rules))
    ;; Collect a list indicating the correct result according to the rules of fizzbuzz:
    ;; NIL means to print the number
    ;; A string means to print that string
    ;; The list starts at 1 and ends at the LCM of all the rule numbers
    (let* ((divs (mapcar #'first rules))
           (lcm (apply #'lcm divs)))
      (loop
        for i from 1 to lcm
        collect (let ((str (apply #'concatenate 'string (mapcar
                                                         (lambda (rule)
                                                           (if (zerop (mod i (first rule)))
                                                               (second rule)
                                                               ""))
                                                         rules))))
                  (if (string= str "") nil str))))))

(defmacro define-fizzbuzz-counter-from-rules (name (&rest rules))
  "Defines a FizzBuzz counter, an object encoding a set of FizzBuzz rules in
an unspecified format.

RULES is a list of lists, with each element list having the form (NUM STRING).
The list is interpreted into a FizzBuzz problem as follows: Given an input
number X, print each STRING for which it is true that the corresponding NUM
divides X, with no separators in between and in the order provided by RULES.
Then, if no STRING is output this way, output X.

In other words, the RULES list for the canonical FizzBuzz problem would be:
((3 \"Fizz\") (5 \"Buzz\"))

After the expanded macro is compiled, NAME will be a special symbol bound to
the FizzBuzz counter encoding RULES."
  `(eval-when (:compile-toplevel :execute)
     (defparameter ,name
       (circular-list
        ,@(make-fizzbuzz-counter-from-rules rules)))))

(define-fizzbuzz-counter-from-rules
    *fizzbuzz-counter*
    ((3 "Fizz")
     (5 "Buzz")))

(define-fizzbuzz-counter-from-rules
    *fizzbuzzquuxquazbasil-counter*
    ((2 "Fizz")
     (3 "Buzz")
     (5 "Quux")
     (7 "Quaz")
     (11 "Basil")))

(eval-when (:compile-toplevel :execute)
  (defun print-fizzbuzz (counter start end &optional (stream *standard-output*))
    "Play the FizzBuzz game encoded by COUNTER, for integers from START to END.

The output is printed to STREAM, which defaults to *STANDARD-OUTPUT*."
    (loop
      for i from start to end
      ;; Count over the circular counter list, starting at the 1-based index start
      ;; since nthcdr deals in zero-based indexes, we have to subtract 1
      for count in (nthcdr (1- start) counter)
      do (format stream "~a~%" (or count i)))))

(defmacro print-fizzbuzz* (counter start end &optional (stream '*standard-output*))
  "Play the FizzBuzz game encoded by COUNTER, for integers from START to END.
This is a macro which may precompute the output if all values are available at
compile time; otherwise, it will simply emit a runtime call to PRINT-FIZZBUZZ.
As such, this macro should be preferred wherever possible.

The output is printed to STREAM, which defaults to *STANDARD-OUTPUT*."
  (if (and (symbolp counter)
           (boundp counter)
           (numberp start)
           (numberp end))
      ;; Build the string at compile time
      (let ((str (with-output-to-string (stream)
                   ;; Note: stream is shadowed, this is not the runtime stream
                   (print-fizzbuzz (symbol-value counter)
                                   start
                                   end
                                   stream))))
        `(progn
           (princ ,str ,stream)
           nil))
      ;; Do the loop at runtime
      `(progn
         (print-fizzbuzz ,counter ,start ,end ,stream)
         nil)))

(defun fizzbuzz (&optional (stream *standard-output*))
  (print-fizzbuzz* *fizzbuzz-counter* 1 100 stream))

(defun fizzbuzzquuxquazbasil (&optional (stream *standard-output*))
  (print-fizzbuzz* *fizzbuzzquuxquazbasil-counter* 2200 2310 stream))