From 4074eb593ae9dfefc657b56f4ba310dfde235aaf Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 26 May 2007 00:52:55 +0000 Subject: [PATCH] revise generator names in for.ss svn: r6329 --- collects/mzlib/for.ss | 296 +++++++++++++++++++++--------------------- 1 file changed, 147 insertions(+), 149 deletions(-) diff --git a/collects/mzlib/for.ss b/collects/mzlib/for.ss index de99c91659..1abd0a4088 100644 --- a/collects/mzlib/for.ss +++ b/collects/mzlib/for.ss @@ -9,55 +9,55 @@ first-for first-for-values first-for* first-for*-values last-for last-for-values last-for* last-for*-values - (rename *range range) - (rename *nat-gen nat-gen) - (rename *list->gen list->gen) - (rename *vector->gen vector->gen) - (rename *string->gen string->gen) - (rename *bytes->gen bytes->gen) - input-port->byte-gen - input-port->char-gen + (rename *in-range in-range) + (rename *in-nats in-nats) + (rename *in-list in-list) + (rename *in-vector in-vector) + (rename *in-string in-string) + (rename *in-bytes in-bytes) + in-input-port-bytes + in-input-port-chars - parallel-gen - stop-before-gen - stop-after-gen - (rename *index-gen index-gen) + in-parallel + stop-before + stop-after + (rename *in-indexed in-indexed) - generator-run + sequence-run - define-generator-syntax - make-do-generator + define-sequence-syntax + make-do-sequence :do-gen) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; generator transformers: + ;; sequence transformers: (begin-for-syntax - (define-values (struct:generator-transformer - make-generator-transformer - generator-transformer? - generator-transformer-ref - generator-transformer-set!) - (make-struct-type 'generator-transformer #f + (define-values (struct:sequence-transformer + make-sequence-transformer + sequence-transformer? + sequence-transformer-ref + sequence-transformer-set!) + (make-struct-type 'sequence-transformer #f 3 0 #f null (current-inspector) 0)) - (define (create-generator-transformer proc1 proc2 cert) + (define (create-sequence-transformer proc1 proc2 cert) (unless (if (identifier? proc1) (and (procedure? proc1) (procedure-arity-includes? proc1 1)) - (raise-type-error 'define-generator-syntax + (raise-type-error 'define-sequence-syntax "identifier of procedure (arity 1)" 0 proc1 proc2)) (unless (and (procedure? proc2) (procedure-arity-includes? proc2 2)) - (raise-type-error 'define-generator-syntax + (raise-type-error 'define-sequence-syntax "procedure (arity 1)" 1 proc1 proc2)) - (make-generator-transformer (if (identifier? proc1) + (make-sequence-transformer (if (identifier? proc1) (lambda (stx) (if (identifier? stx) proc1 @@ -115,7 +115,7 @@ (define (expand-clause orig-stx clause) (let eloop ([use-transformer? #t]) - (syntax-case clause (values parallel-gen stop-before-gen stop-after-gen :do-gen) + (syntax-case clause (values in-parallel stop-before stop-after :do-gen) [[(id ...) rhs] (let ([ids (syntax->list #'(id ...))]) (for-each (lambda (id) @@ -130,7 +130,7 @@ (when dup (raise-syntax-error #f - "duplicate identifier as generator binding" + "duplicate identifier as sequence binding" orig-stx dup))) #f) @@ -138,11 +138,11 @@ [[(id ...) (form . rest)] (and use-transformer? (identifier? #'form) - (generator-transformer? (syntax-local-value #'form (lambda () #f)))) + (sequence-transformer? (syntax-local-value #'form (lambda () #f)))) (let ([m (syntax-local-value #'form)]) - (let ([xformer (generator-transformer-ref m 1)] + (let ([xformer (sequence-transformer-ref m 1)] [introducer (make-syntax-introducer)] - [certifier (generator-transformer-ref m 2)]) + [certifier (sequence-transformer-ref m 2)]) (let ([xformed (xformer orig-stx (introducer (syntax-local-introduce clause)))]) (if xformed (expand-clause orig-stx (certify-clause (syntax-local-introduce (introducer xformed)) @@ -162,10 +162,10 @@ [else (raise-syntax-error #f "bad :do-gen clause" orig-stx clause)])] [[(id) (values rhs)] (expand-clause orig-stx #'[(id) rhs])] - [[(id ...) (parallel-gen rhs ...)] + [[(id ...) (in-parallel rhs ...)] (and (= (length (syntax->list #'(id ...))) (length (syntax->list #'(rhs ...))))) - ;; flatten parallel-gen iterations: + ;; flatten in-parallel iterations: (with-syntax ([(((outer-binding ...) outer-check (loop-binding ...) @@ -186,7 +186,7 @@ (and pre-guard ...) (and post-guard ...) (loop-arg ... ...)))] - [[(id ...) (stop-before-gen gen-expr pred)] + [[(id ...) (stop-before gen-expr pred)] (with-syntax ([((outer-binding ...) outer-check (loop-binding ...) @@ -204,7 +204,7 @@ (and pre-guard (not (pred id ...))) post-guard (loop-arg ...)))] - [[(id ...) (stop-after-gen gen-expr pred)] + [[(id ...) (stop-after gen-expr pred)] (with-syntax ([((outer-binding ...) outer-check (loop-binding ...) @@ -228,7 +228,7 @@ (syntax-local-introduce (introducer #`(([(pos->vals pos-next init pos-cont? val-cont? all-cont?) - (#,((syntax-local-certifier #f) #'make-generator) '(id ...) rhs)]) + (#,((syntax-local-certifier #f) #'make-sequence) '(id ...) rhs)]) (void) ([pos init]) (pos-cont? pos) @@ -239,7 +239,7 @@ [_else (raise-syntax-error #f - "bad generator binding clause" + "bad sequence binding clause" orig-stx clause)])))) @@ -247,48 +247,48 @@ (raise-syntax-error #f "illegal outside of a loop or comprehension binding" stx)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; generators + ;; sequences - (define-values (prop:generator :generator? :generator-ref) - (make-struct-type-property 'generator + (define-values (prop:sequence :sequence? :sequence-ref) + (make-struct-type-property 'sequence (lambda (v sinfo) (unless (and (procedure? v) (procedure-arity-includes? v 1)) (raise-type-error - 'generator-property-guard + 'sequence-property-guard "procedure (arity 1)" v)) v))) - (define-values (struct:do-generator - make-do-generator - do-generator? - do-generator-ref - do-generator-set!) - (make-struct-type 'generator #f + (define-values (struct:do-sequence + make-do-sequence + do-sequence? + do-sequence-ref + do-sequence-set!) + (make-struct-type 'sequence #f 1 0 #f - (list (cons prop:generator (lambda (v) - ((do-generator-ref v 0))))))) + (list (cons prop:sequence (lambda (v) + ((do-sequence-ref v 0))))))) - (define-syntax define-generator-syntax + (define-syntax define-sequence-syntax (syntax-rules () [(_ id expr-transformer-expr clause-transformer-expr) - (define-syntax id (create-generator-transformer + (define-syntax id (create-sequence-transformer expr-transformer-expr clause-transformer-expr (syntax-local-certifier #f)))])) - (define (generator? v) - (or (:generator? v) + (define (sequence? v) + (or (:sequence? v) (list? v) (vector? v) (string? v) (bytes? v) (input-port? v))) - (define (make-generator who v) + (define (make-sequence who v) (cond - [(:generator? v) ((:generator-ref v) v)] + [(:sequence? v) ((:sequence-ref v) v)] [(list? v) (:list-gen v)] [(vector? v) (:vector-gen v)] [(string? v) (:string-gen v)] @@ -296,22 +296,22 @@ [(input-port? v) (:input-port-gen v)] [else (raise (make-exn:fail:contract - (format "for: expected a generator for ~a, got something else: ~v" + (format "for: expected a sequence for ~a, got something else: ~v" (if (= 1 (length who)) (car who) who) v) (current-continuation-marks)))])) - (define range + (define in-range (case-lambda - [(b) (range 0 b 1)] - [(a b) (range a b 1)] + [(b) (in-range 0 b 1)] + [(a b) (in-range a b 1)] [(a b step) - (unless (real? a) (raise-type-error 'range "real-number" a)) - (unless (real? b) (raise-type-error 'range "real-number" b)) - (unless (real? step) (raise-type-error 'range "real-number" step)) - (make-do-generator (lambda () + (unless (real? a) (raise-type-error 'in-range "real-number" a)) + (unless (real? b) (raise-type-error 'in-range "real-number" b)) + (unless (real? step) (raise-type-error 'in-range "real-number" step)) + (make-do-sequence (lambda () (values (lambda (x) x) (lambda (x) (+ x step)) @@ -322,8 +322,8 @@ (lambda (x) #t) (lambda (x y) #t))))])) - (define (nat-gen) - (make-do-generator (lambda () + (define (in-nats) + (make-do-sequence (lambda () (values values add1 0 @@ -331,16 +331,16 @@ (lambda (x) #t) (lambda (x y) #t))))) - (define (list->gen l) - (unless (list? l) (raise-type-error 'list->gen "list" l)) - (make-do-generator (lambda () (:list-gen l)))) + (define (in-list l) + (unless (list? l) (raise-type-error 'in-list "list" l)) + (make-do-sequence (lambda () (:list-gen l)))) (define (:list-gen l) (values car cdr l pair? (lambda (x) #t) (lambda (p x) #t))) - (define (vector->gen l) - (unless (vector? l) (raise-type-error 'vector->gen "vector" l)) - (make-do-generator (lambda () (:vector-gen l)))) + (define (in-vector l) + (unless (vector? l) (raise-type-error 'in-vector "vector" l)) + (make-do-sequence (lambda () (:vector-gen l)))) (define (:vector-gen v) (let ([len (vector-length v)]) @@ -352,9 +352,9 @@ (lambda (x) #t) (lambda (x y) #t)))) - (define (string->gen l) - (unless (string? l) (raise-type-error 'string->gen "string" l)) - (make-do-generator (lambda () (:string-gen l)))) + (define (in-string l) + (unless (string? l) (raise-type-error 'in-string "string" l)) + (make-do-sequence (lambda () (:string-gen l)))) (define (:string-gen v) (let ([len (string-length v)]) @@ -366,9 +366,9 @@ (lambda (x) #t) (lambda (x y) #t)))) - (define (bytes->gen l) - (unless (bytes? l) (raise-type-error 'bytes->gen "bytes" l)) - (make-do-generator (lambda () (:bytes-gen l)))) + (define (in-bytes l) + (unless (bytes? l) (raise-type-error 'in-bytes "bytes" l)) + (make-do-sequence (lambda () (:bytes-gen l)))) (define (:bytes-gen v) (let ([len (bytes-length v)]) @@ -380,9 +380,9 @@ (lambda (x) #t) (lambda (x y) #t)))) - (define (input-port->byte-gen l) - (unless (input-port? l) (raise-type-error 'input-port->byte-gen "input-port" l)) - (make-do-generator (lambda () (:input-port-gen l)))) + (define (in-input-port-bytes l) + (unless (input-port? l) (raise-type-error 'in-input-port-bytes "input-port" l)) + (make-do-sequence (lambda () (:input-port-gen l)))) (define (:input-port-gen v) (values (lambda (v) (read-byte v)) @@ -392,9 +392,9 @@ (lambda (x) (not (eof-object? x))) (lambda (x v) #t))) - (define (input-port->char-gen v) - (unless (input-port? v) (raise-type-error 'input-port->char-gen "input-port" v)) - (make-do-generator (lambda () + (define (in-input-port-chars v) + (unless (input-port? v) (raise-type-error 'in-input-port-chars "input-port" v)) + (make-do-sequence (lambda () (values (lambda (v) (read-char v)) (lambda (v) v) v @@ -402,14 +402,14 @@ (lambda (x) (not (eof-object? x))) (lambda (x v) #t))))) - (define (stop-before-gen g pred) - (unless (generator? g) (raise-type-error 'stop-before-gen "generator" g)) + (define (stop-before g pred) + (unless (sequence? g) (raise-type-error 'stop-before "sequence" g)) (unless (and (procedure? pred) (procedure-arity-includes? pred 1)) - (raise-type-error 'stop-before-gen "procedure (arity 1)" pred)) - (make-do-generator (lambda () + (raise-type-error 'stop-before "procedure (arity 1)" pred)) + (make-do-sequence (lambda () (let-values ([(pos->val pos-next init pos-cont? pre-cont? post-cont?) - (make-generator #f g)]) + (make-sequence #f g)]) (values pos->val pos-next init @@ -421,14 +421,14 @@ (not (apply pred vals)))]) post-cont?))))) - (define (stop-after-gen g pred) - (unless (generator? g) (raise-type-error 'stop-after-gen "generator" g)) + (define (stop-after g pred) + (unless (sequence? g) (raise-type-error 'stop-after "sequence" g)) (unless (and (procedure? pred) (procedure-arity-includes? pred 1)) - (raise-type-error 'stop-after-gen "procedure (arity 1)" pred)) - (make-do-generator (lambda () + (raise-type-error 'stop-after "procedure (arity 1)" pred)) + (make-do-sequence (lambda () (let-values ([(pos->val pos-next init pos-cont? pre-cont? post-cont?) - (make-generator #f g)]) + (make-sequence #f g)]) (values pos->val pos-next init @@ -440,11 +440,11 @@ [(pos . vals) (and (apply pos-cont? pos vals) (not (apply pred vals)))])))))) - (define (index-gen g) - (unless (generator? g) (raise-type-error 'index-gen "generator" g)) - (make-do-generator (lambda () + (define (in-indexed g) + (unless (sequence? g) (raise-type-error 'in-indexed "sequence" g)) + (make-do-sequence (lambda () (let-values ([(pos->val pos-next init pos-cont? pre-cont? post-cont?) - (make-generator #f g)]) + (make-sequence #f g)]) (values (lambda (pos) (values (pos->val (car pos)) (cdr pos))) (lambda (pos) (cons (pos-next (car pos)) (add1 (cdr pos)))) (cons init 0) @@ -454,18 +454,18 @@ ;; ---------------------------------------- - (define (parallel-gen . generators) + (define (in-parallel . sequences) (for-each (lambda (g) - (unless (generator? g) - (raise-type-error 'parallel-gen "generator" g))) - generators) - (if (= 1 (length generators)) - (car generators) - (make-do-generator + (unless (sequence? g) + (raise-type-error 'in-parallel "sequence" g))) + sequences) + (if (= 1 (length sequences)) + (car sequences) + (make-do-sequence (lambda () (let-values ([(pos->vals pos-nexts inits pos-cont?s pre-cont?s post-cont?s) - (lists-for (p->v p-s i ps? pr? po?) ([g generators]) - (make-generator #f g))]) + (lists-for (p->v p-s i ps? pr? po?) ([g sequences]) + (make-sequence #f g))]) (values (lambda (poses) (apply values (map (lambda (pos->val pos) (pos->val pos)) pos->vals @@ -486,19 +486,19 @@ vals)))))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; runnign generators outside of a loop: + ;; runnign sequences outside of a loop: - (define (generator-run g) - (unless (generator? g) - (raise-type-error 'generator-run "generator" g)) + (define (sequence-run g) + (unless (sequence? g) + (raise-type-error 'sequence-run "sequence" g)) (let-values ([(pos->val pos-next init pos-cont? pre-cont? post-cont?) - (make-generator #f g)]) + (make-sequence #f g)]) (let ([pos init]) (letrec ([more? #f] [prep-val! #f] [next #f]) (letrec ([no-more (lambda () - (error "generator has no more values"))] + (error "sequence has no more values"))] [init-more? (lambda () (prep-val!) (more?))] [init-next @@ -539,10 +539,10 @@ (set! more? init-more?) (set! prep-val! init-prep-val!) (set! next init-next) - (let ([generator-more? (lambda () (more?))] - [generator-next (lambda () (next))]) - (values generator-more? - generator-next))))))) + (let ([sequence-more? (lambda () (more?))] + [sequence-next (lambda () (next))]) + (values sequence-more? + sequence-next))))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; core `fold-for' syntax @@ -588,12 +588,12 @@ [(_ [orig-stx . _rest] fold-bind ()) (raise-syntax-error #f - "missing body expression after generator bindings" + "missing body expression after sequence bindings" #'orig-stx)] [(_ [orig-stx . _rest] fold-bind () . rest) (raise-syntax-error #f - "bad syntax (illegal use of `.') after generator bindings" + "bad syntax (illegal use of `.') after sequence bindings" #'orig-stx)] ;; Guard case, no pending emits: [(_ [orig-stx multi? first-multi? nested? #f ()] ([fold-var fold-init] ...) (#:when expr . rest) . body) @@ -611,7 +611,7 @@ [(_ [orig-stx #f #f nested? #f binds] fold-bind (clause . rest) . body) (raise-syntax-error #f - "bad generator binding clause" + "bad sequence binding clause" #'orig-stx #'clause)] ;; Expand one multi-value clause, and push it into the results to emit: @@ -745,19 +745,19 @@ (define-for-variants (and-for and-for-values and-for* and-for*-values) ([result #t]) (lambda (x) x) - (lambda (rhs) #`(stop-after-gen #,rhs (lambda x (not result)))) + (lambda (rhs) #`(stop-after #,rhs (lambda x (not result)))) (lambda (x) x)) (define-for-variants (or-for or-for-values or-for* or-for*-values) ([result #f]) (lambda (x) x) - (lambda (rhs) #`(stop-after-gen #,rhs (lambda x result))) + (lambda (rhs) #`(stop-after #,rhs (lambda x result))) (lambda (x) x)) (define-for-variants (first-for first-for-values first-for* first-for*-values) ([val #f][stop? #f]) (lambda (x) #`(let-values ([(val _) #,x]) val)) - (lambda (rhs) #`(stop-after-gen #,rhs (lambda x stop?))) + (lambda (rhs) #`(stop-after #,rhs (lambda x stop?))) (lambda (x) #`(values #,x #t))) (define-for-variants (last-for last-for-values last-for* last-for*-values) @@ -767,10 +767,10 @@ (lambda (x) x)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; specific generators + ;; specific sequences - (define-generator-syntax *range - #'range + (define-sequence-syntax *in-range + #'in-range (lambda (orig-stx stx) (let loop ([stx stx]) (syntax-case stx () @@ -779,11 +779,9 @@ ;; outer bindings: ([(start) a] [(end) b] [(inc) step]) ;; outer check: - (void) -#; (unless (and (real? a) (real? b) (real? inc)) - ;; let `range' report the error: - (range start end inc)) + ;; let `in-range' report the error: + (in-range start end inc)) ;; loop bindings: ([pos start]) ;; pos check @@ -806,8 +804,8 @@ [[(id) (_ b)] (loop #'[(id) (_ 0 b 1)])] [_else #f])))) - (define-generator-syntax *nat-gen - #'nat-gen + (define-sequence-syntax *in-nats + #'in-nats (lambda (orig-stx stx) (syntax-case stx () [[(id) (_)] #`[(id) @@ -830,8 +828,8 @@ ((+ pos 1)))]] [_else #f]))) - (define-generator-syntax *list->gen - #'list->gen + (define-sequence-syntax *in-list + #'in-list (lambda (orig-stx stx) (syntax-case stx () [((id) (_ lst-expr)) @@ -840,7 +838,7 @@ ;;outer bindings ([(lst) lst-expr]) ;; outer check - (unless (list? lst) (list->gen lst)) + (unless (list? lst) (in-list lst)) ;; loop bindings ([lst lst]) ;; pos check @@ -857,11 +855,11 @@ (define-for-syntax (vector-like-gen vector?-id vector-length-id - vector->gen-id + in-vector-id vector-ref-id) (lambda (orig-stx stx) (with-syntax ([vector? vector?-id] - [vector->gen vector->gen-id] + [in-vector in-vector-id] [vector-length vector-length-id] [vector-ref vector-ref-id]) (syntax-case stx () @@ -871,7 +869,7 @@ ;;outer bindings ([(vec len) (let ([vec vec-expr]) (unless (vector? vec) - (vector->gen vec)) + (in-vector vec)) (values vec (vector-length vec)))]) ;; outer check #f @@ -889,30 +887,30 @@ ((add1 pos)))]] [_else #f])))) - (define-generator-syntax *vector->gen - #'vector->gen + (define-sequence-syntax *in-vector + #'in-vector (vector-like-gen #'vector? #'vector-length - #'vector->gen + #'in-vector #'vector-ref)) - (define-generator-syntax *string->gen - #'string->gen + (define-sequence-syntax *in-string + #'in-string (vector-like-gen #'string? #'string-length - #'string->gen + #'in-string #'string-ref)) - (define-generator-syntax *bytes->gen - #'bytes->gen + (define-sequence-syntax *in-bytes + #'in-bytes (vector-like-gen #'bytes? #'bytes-length - #'bytes->gen + #'in-bytes #'bytes-ref)) - (define-generator-syntax *index-gen - #'index-gen + (define-sequence-syntax *in-indexed + #'in-indexed (lambda (orig-stx stx) (syntax-case stx () [((id1 id2) (_ gen-expr)) - #'[(id1 id2) (parallel-gen gen-expr (*nat-gen))]])))) + #'[(id1 id2) (in-parallel gen-expr (*in-nats))]]))))