Re: Guile 1.8 code failing in 2.x

[Richard Shann]

Thank you! I have applied your fix

Richard

On Mon, 2013-02-25 at 20:28 +0100, Stefan Israelsson Tampe wrote:
> 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))))))))))
> >
> >