Another bug in Ikarus Scheme?
I've run into another problem that seems to be a bug in Ikarus Scheme, this
one in the processing of syntax definitions. This is supposed to be one of
Ikarus's strong points -- the implementer published a paper on the portable
syntax-case system that he developed for Ikarus -- so I was
surprised to encounter this difficulty.
I'm using syntax-case to automate the implementation of
"tuple" data types -- fixed-length lists in which each position is supposed
to hold values of a specified type. The idea is that I want to be able to
write something like
(define-tuple star (name string? string=?)
(magnitude number? =)
(distance number? =)
(spectral-class symbol? symbol=?))
and have it expand into a sequence of definitions: a constructor, a selector for each field, a "disaggregator" that returns the components as separate values, a classification predicate, and an equality predicate, thus:
(begin
(define (make-star name magnitude distance spectral-class)
(list name magnitude distance spectral-class))
(define (star-name star)
(list-ref star 0))
(define (star-magnitude star)
(list-ref star 1))
(define (star-distance star)
(list-ref star 2))
(define (star-spectral-class star)
(list-ref star 3))
(define (destar star)
(apply values star))
(define (star? something)
(and (list? something)
(= (length something) 4)
(string? (list-ref star 0))
(number? (list-ref star 1))
(number? (list-ref star 2))
(symbol? (list-ref star 3))))
(define (star=? left right)
(and (string=? (list-ref left 0) (list-ref right 0))
(= (list-ref left 1) (list-ref right 1))
(= (list-ref left 2) (list-ref right 2))
(symbol=? (list-ref left 3) (list-ref right 3)))))
Here's my definition of the define-tuple syntax:
(define-syntax define-tuple
(letrec ((as-string
(lambda (x)
(cond ((identifier? x)
(as-string (syntax->datum x)))
((symbol? x)
(symbol->string x))
((string? x) x))))
(construct-id
(lambda (context . parts)
(datum->syntax context
(string->symbol
(apply string-append
(map as-string parts))))))
(iota
(lambda (n)
(let loop ((count n) (so-far '()))
(if (zero? count)
so-far
(let ((next (- count 1)))
(loop next (cons next so-far))))))))
(lambda (input-form)
(syntax-case input-form ()
((_ type-name (field-name classification equality) ...)
(with-syntax ((constructor-name
(construct-id #'type-name "make-" #'type-name))
((selector-name ...)
(map (lambda (fn)
(construct-id #'type-name
#'type-name
"-"
fn))
#'(field-name ...)))
(field-count
(datum->syntax #'type-name
(length #'(field-name ...))))
((field-index ...)
(iota (length #'(field-name ...))))
(disaggregator-name
(construct-id #'type-name "de" #'type-name))
(classification-predicate-name
(construct-id #'type-name #'type-name "?"))
(equality-predicate-name
(construct-id #'type-name #'type-name "=?")))
#'(begin
(define (constructor-name field-name ...)
(list field-name ...))
(define (selector-name type-name)
(list-ref type-name field-index)) ...
(define (disaggregator-name type-name)
(apply values type-name))
(define (classification-predicate-name something)
(and (list? something)
(= (length something) field-count)
(classification
(list-ref something field-index)) ...))
(define (equality-predicate-name left right)
(and (equality (list-ref left field-index)
(list-ref right field-index))
...)))))))))
Ikarus accepts this syntax definition without complaining, but hangs
when it encounters any use of define-tuple, as if it can't
complete the expansion process. Neither PLT Racket nor Larceny has this
problem.