bug#16726: Possible bug?

[Nigel Warner <nwarner84@gmail.com>]

#|
   This file is an extract of a documentation and code assembly process
   which works from a list of elements and attributes. Perhaps I'm
   being particularly stupid but I can't see why the function
   emit-groff-bug? does not work as expected.

   Version is 2.09 GCC is 4.7.3 on 64 bit Ubuntu self compiled.

   BTW, thanks to all the developers for a wonderful program. I am
   greatly enjoying programming in Guile.

|#
(define-syntax say
   (syntax-rules ()
    ((say format-string ...)
     (format #t format-string ...))
    ((say format-string)
     (format #t format-string))))

(define-syntax emit
   (syntax-rules ()
     ((emit a-string)
      (say (string-append a-string "\n")))
     ((emit a-string ...)
      (say (string-append (format #f a-string ...) "\n")))))


(define canvas-description
"A canvas object specifies the two dimensional area on which graphics
objects are painted.

The function `canvas' requires at least one parameter, the name by
which the canvas will be known. If there is already a canvas by that
name in the canvas-table then it will be used as the current
canvas. If not then a new canvas will be created using the default
values unless overridden by keyword value pairs passed to the
function.")

(define thoth-canvas
   `((#:object-name . canvas)
     (#:description . ,canvas-description)
     (#:attributes
       (viewbox none "Creates user coordinate space")
       (background none "Creates a background rectangle")
       (transform none "Transformation object"))))

(define (process-attributes-for-groff lst)
   (for-each
     (lambda (element)
      (emit ".attribute ~a ~a" (list-ref element 0)
                               (list-ref element 1))
      (emit ".start-hint")
      (emit "~a" (list-ref element 2))
      (emit ".end-hint"))
    lst))

(define (emit-groff lst)
   (for-each
    (lambda (element)
      (cond ((and (pair? element)
                  (eq? #:object-name (car element)))
             (emit ".object-name ~a" (cdr element)))
            ((and (pair? element)
                  (eq? #:description (car element)))
             (emit ".start-description")
             (emit "~a" (cdr element))
             (emit ".end-description"))
            ((and (list? element)
                  (eq? #:attributes (car element)))
             (process-attributes-for-groff (cdr element)))
            (else
             (emit "emit-groff | unknown list type")
             (throw 'snafu))))
    lst))

(define (emit-groff-bug? lst)
   (for-each
    (lambda (element)
      (cond ((pair? element)
             (cond ((eq? #:object-name (car element))
                    (emit ".object-name ~a" (cdr element)))
                   ((eq? #:description (car element))
                    (emit ".start-description")
                    (emit "~a" (cdr element))
                    (emit ".end-description"))))
            ((list? element)
             (cond ((eq? #:attributes (car element)))
                   (process-attributes-for-groff (cdr element)))
             (else
              (emit "emit-groff | unknown list type")
              (throw 'snafu)))))
    lst))

  (emit "------------- working")
  (emit-groff thoth-canvas)
  (emit "------------- not working")
  (emit-groff-bug? thoth-canvas)