From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: amirouche@hyper.dev Newsgroups: gmane.lisp.guile.user Subject: prompt and generator Date: Sun, 05 May 2019 18:48:52 +0200 Message-ID: Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII; format=flowed Content-Transfer-Encoding: 7bit Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="84218"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Roundcube Webmail/1.3.8 To: guile-user gnu Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sun May 05 18:49:27 2019 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.89) (envelope-from ) id 1hNKKN-000LoH-8p for guile-user@m.gmane.org; Sun, 05 May 2019 18:49:27 +0200 Original-Received: from localhost ([127.0.0.1]:43613 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hNKKM-0002xt-A6 for guile-user@m.gmane.org; Sun, 05 May 2019 12:49:26 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:60310) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hNKJy-0002xd-FG for guile-user@gnu.org; Sun, 05 May 2019 12:49:03 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hNKJw-0004BQ-HM for guile-user@gnu.org; Sun, 05 May 2019 12:49:02 -0400 Original-Received: from relay9-d.mail.gandi.net ([217.70.183.199]:59025) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hNKJv-00046b-8o for guile-user@gnu.org; Sun, 05 May 2019 12:48:59 -0400 Original-Received: from webmail.gandi.net (webmail14.sd4.0x35.net [10.200.201.14]) (Authenticated sender: amirouche@hyper.dev) by relay9-d.mail.gandi.net (Postfix) with ESMTPA id 1DE84FF803 for ; Sun, 5 May 2019 16:48:52 +0000 (UTC) X-Sender: amirouche@hyper.dev X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 217.70.183.199 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.org gmane.lisp.guile.user:15450 Archived-At: 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 # () (#)) ;;; (inner-fold ()) ;;; (inner-fold-vs ((a 1))) ;;; (args # () ((a 1) ())) ;;; (new ((a 1))) ;;; (inner-fold ((a 1))) ;;; (inner-fold-vs ((b 2))) ;;; (args # () ((b 2) ())) ;;; (new ((b 2))) ;;; (inner-fold ((b 2))) ;;; (inner-fold-vs ((c 3))) ;;; (args # ((b 2)) ((c 3) ((b 2)))) ;;; (new ((c 3) (b 2))) ;;; (inner-fold ((c 3) (b 2))) ;;; (inner-fold-vs (#)) ;;; (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