From 51bf69e3562bdbc45184eabe1722da135431ea43 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 20 Jun 2017 06:51:33 -0600 Subject: [PATCH] switch `for/list` back to a loop plus `reverse` Closes #1721, which points out that the `for/list` expansion introduced in commit 5e94a906cd interacts badly with a body that captures a continuation plus Racket's current implemenation of continuations. When Racket one day gets a better implementation of continuations, this change could be considered again, but the general question is whether programs can detect or be affected by the size of the continuation (when the programs don't directly control the continuation creation --- otherwise continuation marks obviously expose the size). --- .../tests/racket/generator.rktl | 24 ++++++++++++++++++- racket/collects/racket/private/for.rkt | 22 ++++------------- 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/generator.rktl b/pkgs/racket-test-core/tests/racket/generator.rktl index 2dfa38f03d..c8d0f5402b 100644 --- a/pkgs/racket-test-core/tests/racket/generator.rktl +++ b/pkgs/racket-test-core/tests/racket/generator.rktl @@ -159,6 +159,28 @@ 'gen-2 (for/list ([(x y) (in-gen-2)]) (cons x y)))) + +;; Make sure that `for/list` doesn't tigger quadtradic-time behavior +;; from `in-producer`, based on test constructed by @kalbr +(let () + (define (make-real-generator N) + (generator + () + (for ([i (in-range N)]) + (yield i)))) + + (define (time-it N) + (let ([start (current-process-milliseconds)]) + (let ([len (length (for/list ([x (in-producer (make-real-generator N) void?)]) + x))]) + (if (zero? len) + (error "that's not right") + (- (current-process-milliseconds) start))))) + + (let loop ([tries 3]) + (when ((time-it 40000) . > . (* 3 (time-it 20000))) + (if (zero? tries) + (error "doubling an `in-producer` sequence seems to take more than twice as long") + (loop (sub1 tries)))))) (report-errs) - diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt index 7cb803f8fd..d75c591b57 100644 --- a/racket/collects/racket/private/for.rkt +++ b/racket/collects/racket/private/for.rkt @@ -1381,11 +1381,6 @@ (define-syntax-rule (inner-recur/fold (fold-var ...) (let () expr ...) next-k) (let-values ([(fold-var ...) (let () expr ...)]) next-k)) - - (define-syntax-rule (inner-recur/list (fold-var ...) (let () expr ...) next-k) - (let-values ([(fold-var ... elem) (let () expr ...)]) - (let-values ([(fold-var ... result) next-k]) - (values* fold-var ... (cons elem result))))) (define-syntax (push-under-break stx) (syntax-case stx () @@ -1554,16 +1549,6 @@ [(_ orig-stx ([fold-var finid-init] ...) . rest) (for/foldX/derived/final [orig-stx #t] ([fold-var finid-init] ...) (values* fold-var ...) . rest)])) - (define-syntax for/list/derived - (syntax-rules () - [(_ orig-stx () . rest) - (for/foldX/derived [orig-stx inner-recur/list #f #f ()] () null null #f . rest)])) - - (define-syntax for*/list/derived - (syntax-rules () - [(_ orig-stx () . rest) - (for/foldX/derived [orig-stx inner-recur/list #t #f ()] () null null #f . rest)])) - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; derived `for' syntax @@ -1660,8 +1645,11 @@ (lambda (x) x) (lambda (x) `(,#'begin ,x ,#'(values)))) - (define-syntax-via-derived for/list for/list/derived () (lambda (x) x) (lambda (x) x) (lambda (x) x)) - (define-syntax-via-derived for*/list for*/list/derived () (lambda (x) x) (lambda (x) x) (lambda (x) x)) + (define-for-variants (for/list for*/list) + ([fold-var null]) + (lambda (x) `(,#'alt-reverse ,x)) + (lambda (x) x) + (lambda (x) `(,#'cons ,x ,#'fold-var))) (define (grow-vector vec) (define n (vector-length vec))