Because my cow-orkers just had to bring up the Dreaded Site™, and I just had to look at the Scheme version and note that, while at least it was present, the organization of the code in all three versions left a great deal to be desired. A few more moments of reading revealed that the output was wrong, too.
I'm sure you can see where this is going.
;; Gnomon - on Thu Apr 17 23:54:52 EDT 2008
;; sha1sum of lastname, firstname, newline:
;; Because I wanted a version that would Do
;; The Right Thing with capitals and plural
;; cases, and because mixing logic, display
;; and generation code does not satisfy me.
(define (iota n)
(let loop ((l '()) (i 0))
(if (> i n)
(loop (cons i l) (+ i 1)))))
;; See SRFI-1 for a better version of this;
;; my function is backward in several ways.
;; It can also be argued that SRFI-42 could
;; allow an implementation that consed up a
;; bit less temporary garbage. If SRFI-1 is
;; out, though, SRFI-42 is way out. Basics.
(define (plural? n . up)
(let ((.. string-append)
(num (number->string n))
(bot " bottle")
(ltr (if (null? up) "n" "N")))
(case n ((0) (.. ltr "o more" bot "s"))
((1) (.. num bot))
(else (.. num bot "s")))))
;; PLURAL? has to merge the logic for cases
;; when the string will be used at the head
;; of a sentence, requiring a capital; when
;; only one bottle is left, which needs the
;; singular form; and when none are left at
;; all, which requires a special case. It's
;; lucky that not all combinations of these
;; cases can be reached, allowing us to use
;; only three of the possible six branches.
(define (verse n)
(let ((.. string-append)
(top (plural? n 1))
(mid (plural? n))
(nxt (plural? (if (= n 0)
(- n 1))))
(beer " of beer")
(wall " on the wall")
(actn (if (= n 0)
"Go to the store and buy some more, "
"Take one down and pass it around, ")))
`(,(.. top beer wall ", " mid beer ".")
. ,(.. actn nxt beer wall "."))))
;; VERSE conses a pair where the CAR stores
;; the first line of the verse, and the CDR
;; the second. There is no sense in using a
;; proper list; we would just waste the end
;; of it anyways. Also: yay quasiquotation!
(define (sing verse)
(let ((n newline))
(display (car verse)) (n)
(display (cdr verse)) (n) (n)))
;; SING exploits the implicit BEGIN wrapped
;; around the body of a LET to DISPLAY both
;; lines of a verse in order. Also note the
;; pleasant symmetry of CAR and CDR that we
;; get to use because of our choice made up
;; above in VERSE to use a dotted pair as a
;; representation instead of a proper list.
(for-each sing (map verse (iota 99)))
;; MAP for effect, FOR-EACH for side effect
It's been submitted for inclusion, of course, with the following lines as an additional note to the site maintainers:
;; The code is long, the comments too;
;; A bit less wrong than version two;
;; No syntax-case, like version three;
;; Just one right place per step, you see.
I'm a little bit in love with the A+ version.