Re: Guile 1.8 code failing in 2.x

[Stefan Israelsson Tampe]

This is a bug in guile-2.0. And should be fixed in the next version I think.

Anyway, fix this by changing it to

  (define-macro (defstruct s . ff) ...)

in stead!

/Stefan


On Mon, Feb 25, 2013 at 8:18 PM, Richard Shann <address@hidden> wrote:
> In GNU/Denemo we have some scheme which has been working in guile 1.8
> but which fails (if I have tested correctly) in guile 2.0
> Apparently the code originated at:
> http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme-Z-H-11.html#node_sec_9.2
>
> I wonder if someone could comment on why it should fail? (I am running
> Debian stable myself so don't have direct access to guile 2.x so my
> testing is limited). - Richard Shann
>
> (define-macro defstruct
>   (lambda (s . ff)
>     (let ((s-s (symbol->string s)) (n (length ff)))
>       (let* ((n+1 (+ n 1))
>              (vv (make-vector n+1)))
>         (let loop ((i 1) (ff ff))
>           (if (<= i n)
>             (let ((f (car ff)))
>               (vector-set! vv i
>                 (if (pair? f) (cadr f) '(if #f #f)))
>               (loop (+ i 1) (cdr ff)))))
>         (let ((ff (map (lambda (f) (if (pair? f) (car f) f))
>                        ff)))
>           `(begin
>              (define ,(string->symbol
>                        (string-append "make-" s-s))
>                (lambda fvfv
>                  (let ((st (make-vector ,n+1)) (ff ',ff))
>                    (vector-set! st 0 ',s)
>                    ,@(let loop ((i 1) (r '()))
>                        (if (>= i n+1) r
>                            (loop (+ i 1)
>                                  (cons `(vector-set! st ,i
>                                           ,(vector-ref vv i))
>                                        r))))
>                    (let loop ((fvfv fvfv))
>                      (if (not (null? fvfv))
>                          (begin
>                            (vector-set! st
>                                (+ (list-position (car fvfv) ff)
>                                   1)
>                              (cadr fvfv))
>                            (loop (cddr fvfv)))))
>                    st)))
>              ,@(let loop ((i 1) (procs '()))
>                  (if (>= i n+1) procs
>                      (loop (+ i 1)
>                            (let ((f (symbol->string
>                                      (list-ref ff (- i 1)))))
>                              (cons
>                               `(define ,(string->symbol
>                                          (string-append
>                                           s-s "." f))
>                                  (lambda (x) (vector-ref x ,i)))
>                               (cons
>                                `(define ,(string->symbol
>                                           (string-append
>                                            "set!" s-s "." f))
>                                   (lambda (x v)
>                                     (vector-set! x ,i v)))
>                                procs))))))
>              (define ,(string->symbol (string-append s-s "?"))
>                (lambda (x)
>                  (and (vector? x)
>                       (eqv? (vector-ref x 0) ',s))))))))))
>
>