Re: a bug soo 21 Jul 2005 03:55 UTC

Here is another stupid but easy example.

> (define x 10)
>
(srfi-let ((a (begin (display "first") (newline) (set! x (+ x 1)) x))
	   (b c (values (begin (display "second") (newline) (set! x 1)
x)
			(begin (display "third") (newline) (set! x 1000)
x)))
	   (d (begin (display "end") (newline) (set! x (+ x 11)) x)))
	  (set! x 10)
	  (list a b c d))
second
third
first
end
(1001 1 1000 1012) ---------------> different result

>
(let ((a (begin (display "first") (newline) (set! x (+ x 1)) x))
      (b (begin (display "second") (newline) (set! x 1) x))
      (c (begin (display "third") (newline) (set! x 1000) x))
      (d (begin (display "end") (newline) (set! x (+ x 11)) x)))
  (set! x 10)
  (list a b c d))
first
second
third
end
(11 1 1000 1011) ---------------> different result

The SRFI-71 implementaion is too difficult for me to understand.
So I will show the followings.

(define-syntax alet
  (syntax-rules ()
    ((alet (clause ...) body1 body2 ...)
     (conversion () (clause ...) body1 body2 ...))
    ((alet name ((a b) ...) body1 body2 ...)
     ((letrec ((name (lambda (a ...) body1 body2 ...)))
	name)
      b ...))))

(define-syntax conversion
  (syntax-rules ()
    ((conversion ((n v) ...) (((a) c) clause ...) body ...)
     ;; This is a bug site. --- ((values a) c) in srfi-71
     ;; (conversion ((n v) ... (a c)) (clause ...) body ...)
     ((lambda (a)
	(conversion ((n v) ... (a a)) (clause ...) body ...)) c))
    ((conversion ((n v) ...) (((a . b) c) clause ...) body ...)
     (dot-values ((n v) ...) ((((a) b) c) clause ...) body ...))
    ((conversion ((n v) ...) (((a . b) c d ...) clause ...) body ...)
     (dot-simple ((n v) ...) ((((a) b) c d ...) clause ...) body ...))
    ((conversion ((n v) ...) ((a b) clause ...) body ...)
     ;; This is a bug site.
     ;; (conversion ((n v) ... (a b)) (clause ...) body ...)
     ((lambda (a)
	(conversion ((n v) ... (a a)) (clause ...) body ...)) b))
    ((conversion ((n v) ...) ((a b c ...) clause ...) body ...)
     (new-values ((n v) ...) (((a) (b c ...)) clause ...) body ...))
    ((conversion ((n v) ...) (a b clause ...) body ...)
     (call-with-values (lambda () b)
       (lambda a
	 (conversion ((n v) ... (a a)) (clause ...) body ...))))
    ((conversion ((n v) ...) () body ...)
     ((lambda (n ...) body ...) v ...))))

(define-syntax new-values
  (syntax-rules ()
    ((new-values ((n v) ...) (((a ...) (a1 a2 a3 ...)) clause ...) body
...)
     (new-values ((n v) ...) (((a ... a1) (a2 a3 ...)) clause ...) body
...))
    ((new-values ((n v) ...) (((a a1 ...) (b)) clause ...) body ...)
     (call-with-values (lambda () b)
       (lambda (a a1 ...)
	 (conversion ((n v) ... (a a) (a1 a1) ...) (clause ...) body
...))))))

(define-syntax dot-values
  (syntax-rules ()
    ((dot-values ((n v) ...) ((((a1 ...) (a . b)) c) clause ...) body
...)
     (dot-values ((n v) ...) ((((a1 ... a) b) c) clause ...) body ...))
    ((dot-values ((n v) ...) ((((a1 ...) ()) c) clause ...) body ...)
     (call-with-values (lambda () c)
       (lambda (a1 ...)
	 (conversion ((n v) ... (a1 a1) ...) (clause ...) body ...))))
    ((dot-values ((n v) ...) ((((a1 ...) b) c) clause ...) body ...)
     (call-with-values (lambda () c)
       (lambda (a1 ... . b)
	 (conversion ((n v) ... (a1 a1) ... (b b)) (clause ...) body
...))))))

(define-syntax dot-simple
  (syntax-rules ()
    ((dot-simple ((n v) ...) ((((a1 ...) (a . b)) c d ...) clause ...)
		 body ...)
     (dot-simple ((n v) ...) ((((a1 ... a) b) c d ...) clause ...) body
...))
    ((dot-simple ((n v) ...) ((((a1 ...) ()) c d ...) clause ...) body
...)
     ((lambda (a1 ...)
	(conversion ((n v) ... (a1 a1) ...) (clause ...) body ...))
      c d ...))
    ((dot-simple ((n v) ...) ((((a1 ...) b) c d ...) clause ...) body
...)
     ((lambda (a1 ... . b)
	(conversion ((n v) ... (a1 a1) ... (b b)) (clause ...) body
...))
      c d ...))))

--
Joo ChurlSoo