* prompt and generator
@ 2019-05-05 16:48 amirouche
2019-05-05 16:54 ` amirouche
0 siblings, 1 reply; 3+ messages in thread
From: amirouche @ 2019-05-05 16:48 UTC (permalink / raw)
To: guile-user gnu
I am trying to replace the use call/cc with prompts.
Here is the definition of 'make-coroutine-generator':
(define (make-coroutine-generator thunk)
(define tag (make-prompt-tag))
(define (run)
(thunk (lambda (val) (abort-to-prompt tag val)))
(eof-object))
(lambda ()
(call-with-prompt tag
run
(lambda (k ret)
(set! run k)
ret))))
Its unit tests pass correctly e.g.:
(define g
(make-coroutine-generator
(lambda (yield) (let loop ((i 0))
(when (< i 3) (yield i) (loop (+ i 1)))))))
(test '(0 1 2) (generator->list g))
Somewhere else, I have the following procedure:
(define (%mapping<=? comparator mapping1 mapping2)
(assume (comparator? comparator))
(assume (mapping? mapping1))
(assume (mapping? mapping2))
(pk 'gen1 (generator->list (tree-generator (mapping-tree mapping1))))
;;(pk 'gen2 (generator->list (tree-generator (mapping-tree
mapping2))))
(let ((less? (comparator-ordering-predicate (mapping-key-comparator
mapping1)))
(equality-predicate (comparator-equality-predicate comparator))
(gen1 (tree-generator (mapping-tree mapping1)))
(gen2 (tree-generator (mapping-tree mapping2))))
(let loop ((item1 (gen1))
(item2 (gen2)))
(pk 'loop item1 item2)
(cond
((eof-object? item1)
#t)
((eof-object? item2)
#f)
(else
(let ((key1 (car item1)) (value1 (cadr item1))
(key2 (car item2)) (value2 (cadr item2)))
(cond
((less? key1 key2)
#f)
((less? key2 key1)
(loop item1 (gen2)))
((equality-predicate value1 value2)
(let* ((item1 (gen1))
(item2 (gen2)))
(loop item1 item2)))
(else
#f))))))))
The above rely on a procedure 'generator-fold':
(define (generator-fold f seed . gs)
(define (inner-fold seedx)
(pk 'inner-fold seedx)
(let ((vs (map (lambda (g) (g)) gs)))
(pk 'inner-fold-vs vs)
(if (any eof-object? vs)
(pk 'out seedx)
(inner-fold (pk 'new (apply f (pk 'args f seedx (append vs
(list seedx)))))))))
(pk 'generator-fold f seed gs)
(inner-fold seed))
Which outputs the following:
;;; (generator-fold #<procedure cons (_ _)> () (#<procedure 22e9600 at
scheme/generator.scm:132:2 ()>))
;;; (inner-fold ())
;;; (inner-fold-vs ((a 1)))
;;; (args #<procedure cons (_ _)> () ((a 1) ()))
;;; (new ((a 1)))
;;; (inner-fold ((a 1)))
;;; (inner-fold-vs ((b 2)))
;;; (args #<procedure cons (_ _)> () ((b 2) ()))
;;; (new ((b 2)))
;;; (inner-fold ((b 2)))
;;; (inner-fold-vs ((c 3)))
;;; (args #<procedure cons (_ _)> ((b 2)) ((c 3) ((b 2))))
;;; (new ((c 3) (b 2)))
;;; (inner-fold ((c 3) (b 2)))
;;; (inner-fold-vs (#<eof>))
;;; (out ())
;;; (gen1 ())
;;; (loop (a 1) (a 1))
;;; (loop (a 1) (b 2))
;;; (mapping=? #f)
The lines starting with ``;;; inner-fold'' should display the
accumulator
of ``generator-fold'' called seedx. Here is only those:
;;; (inner-fold ())
;;; (inner-fold ((a 1)))
;;; (inner-fold ((b 2)))
;;; (inner-fold ((c 3) (b 2)))
At some point the (a 1) is lost.
Also in the end 'generator-fold' returns the empty list:
;;; (out ())
Is my definition of 'make-coroutine-generator' buggy or is it something
else?
If you want to reproduce the issue live you can do the following:
$ git clone https://git.sr.ht/~amz3/guile-r7rs r7rs
$ cd r7rs
$ git checkout wip-delimited-continuation
$ ./bootstrap && ./configure && make
$ ./pre-inst-env guile tests.scm
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2019-05-08 21:48 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-05-05 16:48 prompt and generator amirouche
2019-05-05 16:54 ` amirouche
2019-05-08 21:48 ` Amirouche Boubekki
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).