[From nobody Tue Jan 17 23:23:39 2012 Return-Path: <emailhelp@friendfeed.com> X-Original-To: rafkind@cs.utah.edu Delivered-To: rafkind@cs.utah.edu Received: from mail-svr1.cs.utah.edu (localhost [127.0.0.1]) by mail-svr1.cs.utah.edu (Postfix) with ESMTP id B7A206500BC for <rafkind@cs.utah.edu>; Tue, 25 Aug 2009 23:32:10 -0600 (MDT) X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on rio.cs.utah.edu X-Spam-Level: X-Spam-Status: No, score=-3.3 required=4.5 tests=AWL,DKIM_SIGNED,DKIM_VALID, DKIM_VALID_AU,DKIM_VERIFIED,HTML_MESSAGE,SPF_HELO_PASS autolearn=ham version=3.2.5 Received: from friendfeed.com (friendfeed.com [64.13.142.66]) by mail-svr1.cs.utah.edu (Postfix) with ESMTP for <rafkind@cs.utah.edu>; Tue, 25 Aug 2009 23:31:39 -0600 (MDT) Received: from [10.5.0.3] (localhost [127.0.0.1]) by friendfeed.com (Postfix) with ESMTP id D3662195A16D for <rafkind@cs.utah.edu>; Tue, 25 Aug 2009 22:31:39 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=friendfeed.com; s=pri; t=1251264699; bh=aJiAjXkelwyL9M0zhcmWoMQa5tIhnW+FLl9OP4n2cx4=; h=Content-Type:MIME-Version:From:To:Subject:Message-Id:Date; b=GaEY1wawXDmqJFDD3ZGerIvpN95WLV3JZFn/lySie7sKGtQnDHJFQwMMTbwHYeq83 TTKwgtoVBF347/jLpoiEpF+vXLX+SB9XKoCIObN+Ie7OKglZcvIpP049p/q3W0JUs/ nCw/V87W0aiBJPLl4AcJNeIjZ99NVnewfHfe//+o= Content-Type: multipart/mixed; boundary="===============6769515391382338040==" MIME-Version: 1.0 From: FriendFeed <emailhelp@friendfeed.com> To: rafkind@cs.utah.edu Subject: Re: [plt-scheme] generators with sequences Message-Id: <20090826053139.D3662195A16D@friendfeed.com> Date: Tue, 25 Aug 2009 22:31:39 -0700 (PDT) --===============6769515391382338040== Content-Type: multipart/alternative; boundary="===============6354000524979849004==" MIME-Version: 1.0 --===============6354000524979849004== Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Hello, Your email message to FriendFeed (included below) was sent from an unauthorized email address (rafkind@cs.utah.edu) and requires approval. Please click on the link below to approve or reject this message. (http://friendfeed.com/approve?key=b48b0c7666c2da205232f9d4b097fe7e) Learn more (http://friendfeed.com/share/mail) about using FriendFeed (http://friendfeed.com/) by email. --===============6354000524979849004== Content-Type: text/html; charset="utf-8" MIME-Version: 1.0 <div> <p>Hello,</p> <p>Your email message to FriendFeed (included below) was sent from an unauthorized email address (rafkind@cs.utah.edu) and requires approval. Please click on the link below to approve or reject this message.</p> <p><a href="http://friendfeed.com/approve?key=b48b0c7666c2da205232f9d4b097fe7e">http://friendfeed.com/approve?key=b48b0c7666c2da205232f9d4b097fe7e</a></p> <p><a href="http://friendfeed.com/share/mail">Learn more</a> about using <a href="http://friendfeed.com/">FriendFeed</a> by email.</p> </div> --===============6354000524979849004==-- --===============6769515391382338040== Content-Type: message/rfc822 MIME-Version: 1.0 Received: by vws32 with SMTP id 32so3248444vws.11 for <9h385duz2br6hm8xlwf7@ffbymail.com>; Tue, 25 Aug 2009 22:31:35 -0700 (PDT) Received: by 10.220.112.197 with SMTP id x5mr9689940vcp.83.1251264695239; Tue, 25 Aug 2009 22:31:35 -0700 (PDT) X-Forwarded-To: 9h385duz2br6hm8xlwf7@ffbymail.com X-Forwarded-For: mail2ff@friendfeed.com 9h385duz2br6hm8xlwf7@ffbymail.com Delivered-To: p-plt-scheme@friendfeed.com Received: by 10.220.45.194 with SMTP id g2cs89820vcf; Tue, 25 Aug 2009 22:31:35 -0700 (PDT) Received: by 10.150.237.1 with SMTP id k1mr12265173ybh.69.1251264694588; Tue, 25 Aug 2009 22:31:34 -0700 (PDT) Received: from mail-yw0-f192.google.com (mail-yw0-f192.google.com [209.85.211.192]) by mx.google.com with ESMTP id 21si14624835gxk.54.2009.08.25.22.31.34; Tue, 25 Aug 2009 22:31:34 -0700 (PDT) Received-SPF: pass (google.com: domain of gtoledano+caf_=p-plt-scheme=friendfeed.com@gmail.com designates 209.85.211.192 as permitted sender) client-ip=209.85.211.192; Authentication-Results: mx.google.com; spf=pass (google.com: domain of gtoledano+caf_=p-plt-scheme=friendfeed.com@gmail.com designates 209.85.211.192 as permitted sender) smtp.mail=gtoledano+caf_=p-plt-scheme=friendfeed.com@gmail.com Received: by ywh30 with SMTP id 30so6235910ywh.25 for <p-plt-scheme@friendfeed.com>; Tue, 25 Aug 2009 22:31:34 -0700 (PDT) Received: by 10.150.103.10 with SMTP id a10mr12216228ybc.173.1251264693370; Tue, 25 Aug 2009 22:31:33 -0700 (PDT) X-Forwarded-To: p-plt-scheme@friendfeed.com X-X-Forwarded-For: gtoledano@gmail.com p-plt-scheme@friendfeed.com Delivered-To: gtoledano@gmail.com Received: by 10.151.149.16 with SMTP id b16cs68626ybo; Tue, 25 Aug 2009 22:31:32 -0700 (PDT) Received: by 10.224.42.134 with SMTP id s6mr4716071qae.352.1251264684962; Tue, 25 Aug 2009 22:31:24 -0700 (PDT) Received: from salt.cs.brown.edu (salt.cs.brown.edu [128.148.32.119]) by mx.google.com with ESMTP id 13si8427735qyk.79.2009.08.25.22.31.23; Tue, 25 Aug 2009 22:31:24 -0700 (PDT) Received-SPF: pass (google.com: domain of plt-scheme-bounces@list.cs.brown.edu designates 128.148.32.119 as permitted sender) client-ip=128.148.32.119; Received: from localhost (localhost [127.0.0.1]) by salt.cs.brown.edu (Postfix) with ESMTP id 8F1F64C5D3; Wed, 26 Aug 2009 01:31:21 -0400 (EDT) Received: from salt.cs.brown.edu ([127.0.0.1]) by localhost (salt.cs.brown.edu [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id z9QD-fPuOtUY; Wed, 26 Aug 2009 01:31:20 -0400 (EDT) Received: from qua.cs.brown.edu (qua.cs.brown.edu [128.148.32.90]) by salt.cs.brown.edu (Postfix) with ESMTP id 4F48D4C5C7; Wed, 26 Aug 2009 01:31:20 -0400 (EDT) Received: from qua.cs.brown.edu (localhost [127.0.0.1]) by qua.cs.brown.edu (Postfix) with ESMTP id B7F92402BE; Wed, 26 Aug 2009 01:31:19 -0400 (EDT) Received: from salt.cs.brown.edu (salt.cs.brown.edu [128.148.32.119]) by qua.cs.brown.edu (Postfix) with ESMTP id 5CCA2402BC for <plt-scheme@list.cs.brown.edu>; Wed, 26 Aug 2009 01:31:01 -0400 (EDT) Received: from localhost (localhost [127.0.0.1]) by salt.cs.brown.edu (Postfix) with ESMTP id 473C64C5C1 for <plt-scheme@list.cs.brown.edu>; Wed, 26 Aug 2009 01:31:01 -0400 (EDT) Received: from salt.cs.brown.edu ([127.0.0.1]) by localhost (salt.cs.brown.edu [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id ava0SHtfrXTh for <plt-scheme@list.cs.brown.edu>; Wed, 26 Aug 2009 01:31:01 -0400 (EDT) Received: from mail-svr1.cs.utah.edu (rio.cs.utah.edu [155.98.64.241]) by salt.cs.brown.edu (Postfix) with ESMTP id D1C704C5C0 for <plt-scheme@list.cs.brown.edu>; Wed, 26 Aug 2009 01:31:00 -0400 (EDT) Received: from localhost (localhost [127.0.0.1]) by mail-svr1.cs.utah.edu (Postfix) with ESMTP id 98A0E6500C3 for <plt-scheme@list.cs.brown.edu>; Tue, 25 Aug 2009 23:30:59 -0600 (MDT) X-Virus-Scanned: amavisd-new at cs.utah.edu Received: from mail-svr1.cs.utah.edu ([127.0.0.1]) by localhost (mail-svr1.cs.utah.edu [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id nU1MbRT78aix for <plt-scheme@list.cs.brown.edu>; Tue, 25 Aug 2009 23:30:58 -0600 (MDT) Received: from [192.168.1.100] (unknown [98.202.86.149]) by smtps.cs.utah.edu (Postfix) with ESMTPSA id 323B36500BC for <plt-scheme@list.cs.brown.edu>; Tue, 25 Aug 2009 23:30:58 -0600 (MDT) Message-ID: <4A94C836.7090608@cs.utah.edu> Date: Tue, 25 Aug 2009 23:29:26 -0600 From: Jon Rafkind <rafkind@cs.utah.edu> User-Agent: Thunderbird 2.0.0.22 (X11/20090608) MIME-Version: 1.0 To: PLT-Scheme Mailing List <plt-scheme@list.cs.brown.edu> Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit Subject: [plt-scheme] generators with sequences X-BeenThere: plt-scheme@list.cs.brown.edu X-Mailman-Version: 2.1.5 Precedence: list Reply-To: rafkind@cs.utah.edu List-Id: PLT Scheme discussion list <plt-scheme.list.cs.brown.edu> List-Unsubscribe: <http://list.cs.brown.edu/mailman/listinfo/plt-scheme>, <mailto:plt-scheme-request@list.cs.brown.edu?subject=unsubscribe> List-Archive: <http://list.cs.brown.edu/pipermail/plt-scheme> List-Post: <mailto:plt-scheme@list.cs.brown.edu> List-Help: <mailto:plt-scheme-request@list.cs.brown.edu?subject=help> List-Subscribe: <http://list.cs.brown.edu/mailman/listinfo/plt-scheme>, <mailto:plt-scheme-request@list.cs.brown.edu?subject=subscribe> Sender: plt-scheme-bounces@list.cs.brown.edu Errors-To: plt-scheme-bounces@list.cs.brown.edu Return-Path: <mail2ff+caf_=9h385duz2br6hm8xlwf7=ffbymail.com@friendfeed.com> I wrote a generator syntax for use with the v4 `for' sequences. Some example usages are below but the main point is you can say (yield 5) when you want a function to produce a value that can be used as a sequence. It took me a few tries to get this right and I left most of my attempts in so others can maybe learn what not to do. This could go into collects/, so if anyone has any improvements please share! The last attempt (test4) is my best effort so far. #lang scheme (require scheme/control) (require scheme/stxparam) (define (check v1 v2) (when (not (equal? v1 v2)) (printf "test failed expected ~a actual ~a\n" v1 v2))) (define (do-tests for-function) (check (for/list ([i (in-range 0 10)]) i) (for/list ([i (in-range 0 10)]) i)) #; (let ([x 0]) (for/list ([i (for-function)]) (printf "i ~a x ~a\n" i x) (set! x (add1 x)) i)) (check (for/list ([i (in-range 0 10)]) i) (let ([x 0]) (for/list ([i (for-function)]) ;; (printf "i ~a x ~a\n" i x) (set! x (add1 x)) i))) (for/list ([i (for-function)] [j (in-range 0 5)]) ;; (printf "i ~a j ~a\n" i j) (list i j)) (check (for/list ([i (in-range 0 10)] [j (in-range 0 5)]) (list i j)) (for/list ([i (for-function)] [j (in-range 0 5)]) ;; (printf "i ~a j ~a\n" i j) (list i j))) (check (for/list ([i (in-range 0 10)] [j (in-range 0 10)]) (list i j)) (for/list ([i (for-function)] [j (for-function)]) (list i j))) (check (for/list ([(v vi) (in-indexed (in-range 0 10))]) (list v vi)) (for/list ([(v vi) (in-indexed (for-function))]) (list v vi))) (check (for/list ([v (in-sequences (in-range 0 10) (in-range 0 10))]) v) (for/list ([v (in-sequences (for-function) (for-function))]) v)) ;; doesn't work yet #; (check (for/list ([v (in-cycle (in-range 0 10))] [x (in-range 0 100)]) v) (for/list ([v (in-cycle (for-function))] [x (in-range 0 100)]) (printf "~a ~a\n" v x) v)) ) ;; completely broken version using call/cc and creating too many sequence objects (define test1 (let () (define-syntax yield (syntax-rules () [(_ yielder value) (call/cc (lambda (ret) (let ([s (make-do-sequence (lambda () (values (lambda (i) value) (lambda (x) (ret #f)) 0 (lambda (x) #t) (lambda (v) (eq? v value)) (lambda (x v) #t))))]) (yielder s))))])) (define-syntax define-generator (syntax-rules () [(_ ret (name args ...) body0 bodies ...) (define (name args ...) (call/cc (lambda (ret) body0 bodies ... (make-do-sequence (lambda () (values (lambda (i) (void)) (lambda (x) (void)) 0 (lambda (x) #f) (lambda (x) #f) (lambda (x y) #f)))) )))])) (define-generator yielder (blah) (for ([x (in-range 0 10)]) (yield yielder x))) (printf "test1\n") (do-tests blah) )) ;; working version using prompt/control (define test2 (let () (define-syntax yield (syntax-rules () [(_ value) ;; Capture the current delimited continuation, f, and pass back to the last prompt a, ;; value and a function that installs a new prompt and continues where f left off. (control f (values value (lambda () (prompt (f)))))])) (define-syntax lambda-generator (syntax-rules () [(_ (args ...) body0 bodies ...) (lambda (args ...) (let* ([current (lambda () (prompt body0 bodies ... ;; (printf "now what\n") (values #f #f) ))] [pos 0] [seq (make-do-sequence (lambda () (values (lambda (i) (let-values ([(value next) (current)]) ;; (printf "Next value is ~a\n" value) (set! current next) value)) (lambda (x) (add1 x)) 0 (lambda (x) current) (lambda (v) current) (lambda (x v) current))))]) seq))])) (define-syntax define-generator (syntax-rules () [(_ (name args ...) body0 bodies ...) (define name (lambda-generator (args ...) body0 bodies ...))])) (define-generator (blah) (for ([x (in-range 0 10)]) (yield x))) (printf "test2\n") (do-tests blah) #; (printf "test3\n") #; (do-tests (lambda () (make-do-sequence (lambda () (values (lambda (i) i) (lambda (x) (add1 x)) 0 (lambda (x) (< x 10)) (lambda (v) #t) (lambda (x v) #t)))))) ;; a cute example #; (let () ;; generate infinte list of unique names (define-generator (machine-names) (define letters "abcdefghijklmnopqrstuvwxyz") (let loop ([len 0]) ;; generates strings of length num (define-generator (generate num) (for ([letter (in-string letters)]) (if (= num 0) (yield (string letter)) (for ([l2 (generate (- num 1))]) (yield (string-append (string letter) l2)))))) (for ([str (generate len)]) (yield str)) (loop (add1 len)))) (for ([s (machine-names)] [j (in-range 0 1000)]) (printf "~a: ~a\n" j s))) )) ;; better version using shift/reset (define test3 (let () (define-syntax yield (syntax-rules () [(_ value) (shift f (values value f))])) (define-syntax lambda-generator (syntax-rules () [(_ (args ...) body0 bodies ...) (lambda (args ...) (let* ([current (lambda () (reset body0 bodies ... ;; (printf "now what\n") (values #f #f) ))] [pos 0] [seq (make-do-sequence (lambda () (values (lambda (i) (let-values ([(value next) (current)]) ;; (printf "Next value is ~a\n" value) (set! current next) value)) (lambda (x) (add1 x)) 0 (lambda (x) current) (lambda (v) current) (lambda (x v) current))))]) seq))])) (define-syntax define-generator (syntax-rules () [(_ (name args ...) body0 bodies ...) (define name (lambda-generator (args ...) body0 bodies ...))])) (define-generator (blah) (for ([x (in-range 0 10)]) (yield x))) (printf "test3\n") (do-tests blah) #; (printf "test3\n") #; (do-tests (lambda () (make-do-sequence (lambda () (values (lambda (i) i) (lambda (x) (add1 x)) 0 (lambda (x) (< x 10)) (lambda (v) #t) (lambda (x v) #t)))))) ;; a cute example #; (let () ;; generate infinte list of unique names (define-generator (machine-names) (define letters "abcdefghijklmnopqrstuvwxyz") (let loop ([len 0]) ;; generates strings of length num (define-generator (generate num) (for ([letter (in-string letters)]) (if (= num 0) (yield (string letter)) (for ([l2 (generate (- num 1))]) (yield (string-append (string letter) l2)))))) (for ([str (generate len)]) (yield str)) (loop (add1 len)))) (for ([s (machine-names)] [j (in-range 0 1000)]) (printf "~a: ~a\n" j s))) )) ;; better version of shift/reset using continuation tags ;; also use a unique value to determine the end of the sequence instead of using #f (define test4 (let () (define-syntax-parameter yield (lambda (stx) (raise-syntax-error #f "yield is only bound inside a sequence generator"))) (define-syntax lambda-generator (syntax-rules () [(_ (args ...) body0 bodies ...) (lambda (args ...) (let* ([last (lambda () (void))] ;; current is a function that invokes user code and produces values [current (lambda () ;; a unique tag to jump to (define tag (make-continuation-prompt-tag)) ;; give the value to the sequence (define next (lambda (value) (shift-at tag f (values value f)))) (syntax-parameterize ([yield (make-rename-transformer #'next)]) (reset-at tag body0 bodies ... (values #f last) )))] [pos 0] [seq (make-do-sequence (lambda () (values ;; produce a value and a continuation (lambda (i) (let-values ([(value next) (current)]) ;; set! is ugly but can we do better? (set! current next) value)) (lambda (x) (add1 x)) 0 (lambda (x) (not (eq? last current))) (lambda (v) (not (eq? last current))) (lambda (x v) (not (eq? last current))))))]) seq))])) (define-syntax define-generator (syntax-rules () [(_ (name args ...) body0 bodies ...) (define name (lambda-generator (args ...) body0 bodies ...))])) (define-generator (blah) (for ([x (in-range 0 10)]) (yield x))) (printf "test4\n") (do-tests blah) (check (for/list ([i ((lambda-generator () (for ([i (in-range 0 5)]) (yield #f))))]) i) (for/list ([i (in-range 0 5)]) #f)) (check (for/list ([i ((lambda-generator () (for ([i (in-range 0 5)]) (yield (reset (for ([j (in-range 2 5)]) (shift k (+ i j))))))))]) i) (for/list ([i (in-range 2 7)]) i)) #; (printf "test3\n") #; (do-tests (lambda () (make-do-sequence (lambda () (values (lambda (i) i) (lambda (x) (add1 x)) 0 (lambda (x) (< x 10)) (lambda (v) #t) (lambda (x v) #t)))))) ;; a cute example #; (let () ;; generate infinte list of unique names (define-generator (machine-names) (define letters "abcdefghijklmnopqrstuvwxyz") (let loop ([len 0]) ;; generates strings of length num (define-generator (generate num) (for ([letter (in-string letters)]) (if (= num 0) (yield (string letter)) (for ([l2 (generate (- num 1))]) (yield (string-append (string letter) l2)))))) (for ([str (generate len)]) (yield str)) (loop (add1 len)))) (for ([s (machine-names)] [j (in-range 0 1000)]) (printf "~a: ~a\n" j s))) )) _________________________________________________ For list-related administrative tasks: http://list.cs.brown.edu/mailman/listinfo/plt-scheme --===============6769515391382338040==-- ]