[plt-scheme] possible map bug? (was: map and call/cc bug with amb-collect?)

Eli Barzilay wrote:
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
> On May 22, Andre van Tonder wrote:
>> I'm having a problem making amb-collect from swindle work with the
>> built-in map function.  The same code works if I define my own map
>> function.  I suspect there may be a subtle bug involving map and
>> call/cc, but I haven't had any luck figuring it out so far.
>
> I tried tracing it, which is not a trivial task...  Anyway, this
> happens with the original implementation from Dorai's tutorial.  I
> could only narrow the problem down to the piece of code below, which
> works as expected with a Scheme version of map.  The debugging
> printouts indicate that the correct values are used, but somehow they
> are collected differently by the primitive map.  I even went down to
> the C level and saw that there are "quick" arrays used for small
> number of arguments -- I tried to play with that by using map with
> more redundant arguments, and the result is clearly bogus (I got a
> ((1) (0 1) (0 1))!).  So I think that this is some bad interaction
> with the C map and catching continuations, and probably a major
> headache to solve.

Your post reminded me about these tests from SISC.
I have cut out the interesting ones. The rest can be found
at
http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/sisc/sisc/tests/r5rs_pitfall.
scm?rev=1.17&content-type=text/vnd.viewcvs-markup


Sorry if this adds to your headache.

/Jens Axel

(define-syntax should-be
  (syntax-rules ()
    ((_ test-id value expression)
     (let ((return-value expression))
         (if (not (equal? return-value value))
           (for-each (lambda (v) (display v))
                     `("Failure: " test-id ", expected '"
                     value "', got '" ,return-value "'." #\newline))
           (for-each (lambda (v) (display v))
                     '("Passed: " test-id #\newline)))))))

(define call/cc call-with-current-continuation)

;; Section 1: Proper letrec implementation

;;Credits to Al Petrofsky
;; In thread:
;; defines in letrec body
;; http://groups.google.com/groups?selm=87bsoq0wfk.fsf%40app.dial.idiom.com
(should-be 1.1 0
 (let ((cont #f))
   (letrec ((x (call-with-current-continuation (lambda (c) (set! cont c)
0)))
            (y (call-with-current-continuation (lambda (c) (set! cont c)
0))))
     (if cont
         (let ((c cont))
           (set! cont #f)
           (set! x 1)
           (set! y 1)
           (c 0))
         (+ x y)))))

;;Credits to Al Petrofsky
;; In thread:
;; Widespread bug (arguably) in letrec when an initializer returns twice
;;
http://groups.google.com/groups?selm=87d793aacz.fsf_-_%40app.dial.idiom.com
(should-be 1.2 #t
  (letrec ((x (call/cc list)) (y (call/cc list)))
    (cond ((procedure? x) (x (pair? y)))
   ((procedure? y) (y (pair? x))))
    (let ((x (car x)) (y (car y)))
      (and (call/cc x) (call/cc y) (call/cc x)))))


;;Not really an error to fail this (Matthias Radestock)
;;If this returns (0 1 0), your map isn't call/cc safe, but is probably
;;tail-recursive.  If its (0 0 0), the opposite is true.
(let ((result
       (let ()
         (define executed-k #f)
         (define cont #f)
         (define res1 #f)
         (define res2 #f)
         (set! res1 (map (lambda (x)
                           (if (= x 0)
                               (call/cc (lambda (k) (set! cont k) 0))
                               0))
                         '(1 0 2)))
         (if (not executed-k)
             (begin (set! executed-k #t)
                    (set! res2 res1)
                    (cont 1)))
         res2)))
  (if (equal? result '(0 0 0))
      (display "Map is call/cc safe, but probably not tail recursive or
inefficient.")
      (display "Map is not call/cc safe, but probably tail recursive and
efficient."))
  (newline))

--
Jens Axel Søgaard