bug#16726: Possible bug?

[Nigel Warner]

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