[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: a bug



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