* Guile 1.8 code failing in 2.x
@ 2013-02-25 19:18 Richard Shann
2013-02-25 19:28 ` Stefan Israelsson Tampe
0 siblings, 1 reply; 3+ messages in thread
From: Richard Shann @ 2013-02-25 19:18 UTC (permalink / raw)
To: guile-user
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))))))))))
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Guile 1.8 code failing in 2.x
2013-02-25 19:18 Guile 1.8 code failing in 2.x Richard Shann
@ 2013-02-25 19:28 ` Stefan Israelsson Tampe
2013-02-25 20:22 ` Richard Shann
0 siblings, 1 reply; 3+ messages in thread
From: Stefan Israelsson Tampe @ 2013-02-25 19:28 UTC (permalink / raw)
To: Richard Shann; +Cc: guile-user
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 <richard.shann@virgin.net> 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))))))))))
>
>
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Guile 1.8 code failing in 2.x
2013-02-25 19:28 ` Stefan Israelsson Tampe
@ 2013-02-25 20:22 ` Richard Shann
0 siblings, 0 replies; 3+ messages in thread
From: Richard Shann @ 2013-02-25 20:22 UTC (permalink / raw)
To: Stefan Israelsson Tampe; +Cc: guile-user
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 <richard.shann@virgin.net> 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))))))))))
> >
> >
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2013-02-25 20:22 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-02-25 19:18 Guile 1.8 code failing in 2.x Richard Shann
2013-02-25 19:28 ` Stefan Israelsson Tampe
2013-02-25 20:22 ` Richard Shann
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).