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

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.

version #1
======================================================================
(define (amb-fail) (error "amb tree exhausted"))
(let ((+results '()))
  (if (call/cc
       (lambda (+k)
         (set! amb-fail (lambda () (+k #f)))
         (let ((+v (map (lambda (x)
                          (let ((+prev-amb-fail amb-fail))
                            (call/cc
                             (lambda (+sk)
                               (call/cc
                                (lambda (+fk)
                                  (set! amb-fail
                                        (lambda ()
                                          (set! amb-fail +prev-amb-fail)
                                          (+fk 'fail)))
                                  (printf ">>> x=~a, collecting 0\n" x)
                                  (+sk 0)))
                               (call/cc
                                (lambda (+fk)
                                  (set! amb-fail
                                        (lambda ()
                                          (set! amb-fail +prev-amb-fail)
                                          (+fk 'fail)))
                                  (printf ">>> x=~a, collecting 1\n" x)
                                  (+sk 1)))
                               (+prev-amb-fail)))))
                        '(1st 2nd))))
           (set! +results (cons +v +results))
           (+k #t))))
    (amb-fail))
  +results)
======================================================================

version #2
======================================================================
(define (amb-fail) (error "amb tree exhausted"))
(let ((+results '()))
  (if (call/cc
       (lambda (+k)
         (set! amb-fail (lambda () (+k #f)))
         (let ((+v (map (lambda (x . xs)
                          (let ((+prev-amb-fail amb-fail))
                            (call/cc
                             (lambda (+sk)
                               (call/cc
                                (lambda (+fk)
                                  (set! amb-fail
                                        (lambda ()
                                          (set! amb-fail +prev-amb-fail)
                                          (+fk 'fail)))
                                  (printf ">>> x=~a, collecting 0\n" x)
                                  (+sk 0)))
                               (call/cc
                                (lambda (+fk)
                                  (set! amb-fail
                                        (lambda ()
                                          (set! amb-fail +prev-amb-fail)
                                          (+fk 'fail)))
                                  (printf ">>> x=~a, collecting 1\n" x)
                                  (+sk 1)))
                               (+prev-amb-fail)))))
                        '(1st 2nd) '(0 0) '(0 0) '(0 0) '(0 0))))
           (set! +results (cons +v +results))
           (+k #t))))
    (amb-fail))
  +results)
======================================================================

-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                  http://www.barzilay.org/                 Maze is Life!