[plt-scheme] Hash-tables and call/cc

Strange, when I test the shift/reset solution i the repl
everthing looks fine. But when I use with srfi-42 this

   (list-ec (:set x (list->set (list 1 2 3)))
            x)

evaluats to (#t #t #t) and not to (1 2 3) as
the call/cc solution did.

Any ideas?

Move the #; to try the other version.


(require (lib "42.ss" "srfi")
          (lib "string.ss")
          (lib "match.ss")
          (lib "control.ss"))

(define-struct set (ht))

(define (empty)
   (make-set (make-hash-table 'equal)))

(define (insert! x s)
   (hash-table-put! (set-ht s) x #t)
   s)

(define (list->set xs)
   (let ([s (empty)])
     (for-each (lambda (x)
                 (insert! x s))
               xs)
     s))


#;
(define (hash-table->generator ht)
   (let ([continue+x
          (reset
           (hash-table-for-each
            ht
            (lambda (x v)
              ;; Return the value and the remaining computation
              (shift f (cons f v))))
           ;; Return a final #f
           (shift f #f))])
     (lambda ()
       (match continue+x
         [(continue . x)  (set! continue+x (continue 'dummy))
                          x]
         [#f              #f]))))

(define (hash-table->generator ht)
   (let ([continue 'start]
         [return   #f])
     (lambda ()
       (let/cc ret
         (set! return ret)
         (case continue
           [(done)    (return #f)]
           [(start)   (hash-table-for-each
                       ht
                       (lambda (x v)
                         (call/cc
                          (lambda (k)
                            (set! continue k)
                            (return x)))))
                      (set! continue 'done)
                      (return #f)]
           [else      (continue)])))))


(define-syntax :set
   (syntax-rules (index)
     ((:set cc var (index i) arg)
      (:parallel cc (:set var arg) (:integers i)) )
     ((:set cc var arg)
      (:do cc
           (let ((g (hash-table->generator (set-ht arg)))))
           ((x (g)))
           x
           (let ((var x)))
           #t
           ((g))))))

(define (:set-dispatch args)
   (cond
     [(null? args)
      'set]
     [(and (= (length args) 1)
           (set? (car args)))
      (:generator-proc
       (:set (car args)))]
     [else
      #f]))

(:-dispatch-set!
  (dispatch-union (:-dispatch-ref) :set-dispatch))

(list-ec (:set x (list->set (list 1 2 3)))
          x)


-- 
Jens Axel Søgaard