From eda69b472ad5de8874ddf99b40f04dea22a9672e Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 9 Sep 2009 21:24:05 +0000 Subject: [PATCH] Remove almost all uses of `stxclass' library. svn: r15944 --- collects/typed-scheme/rep/interning.ss | 25 ++----- collects/typed-scheme/rep/rep-utils.ss | 68 +++++++++++-------- .../typed-scheme/typecheck/find-annotation.ss | 4 +- collects/typed-scheme/typecheck/tc-app.ss | 41 ++++++----- .../typed-scheme/typecheck/tc-expr-unit.ss | 2 +- .../typed-scheme/typecheck/tc-let-unit.ss | 4 +- collects/typed-scheme/types/abbrev.ss | 8 +-- collects/typed-scheme/types/convenience.ss | 12 ++-- collects/typed-scheme/types/subtype.ss | 7 +- collects/typed-scheme/types/utils.ss | 2 +- collects/typed-scheme/utils/stxclass-util.ss | 12 ++-- collects/typed-scheme/utils/tc-utils.ss | 4 +- collects/typed-scheme/utils/utils.ss | 6 +- 13 files changed, 98 insertions(+), 97 deletions(-) diff --git a/collects/typed-scheme/rep/interning.ss b/collects/typed-scheme/rep/interning.ss index 83551c46b2..3dfd9aeffb 100644 --- a/collects/typed-scheme/rep/interning.ss +++ b/collects/typed-scheme/rep/interning.ss @@ -1,21 +1,19 @@ #lang scheme/base -(require syntax/boundmap (for-syntax scheme/base stxclass) - #;macro-debugger/stepper) +(require syntax/boundmap (for-syntax scheme/base syntax/parse)) (provide defintern hash-id) (define-syntax (defintern stx) (syntax-parse stx - [(_ name+args make-name key (~or [#:extra-arg e:expr] #:opt) ...) - (if #'e + [(_ name+args make-name key (~optional (~seq #:extra-arg e:expr)) ...) + (if (attribute e) #'(defintern name+args (lambda () (make-hash #;'weak)) make-name key #:extra-arg e) #'(defintern name+args (lambda () (make-hash #;'weak)) make-name key))] - [(_ (*name:id arg:id ...) make-ht make-name key-expr (~or [#:extra-arg e:expr]) ...) + [(_ (*name:id arg:id ...) make-ht make-name key-expr (~seq #:extra-arg e:expr) ...) #'(define *name (let ([table (make-ht)]) (lambda (arg ...) - #;(all-count!) (let ([key key-expr]) (hash-ref table key (lambda () @@ -23,24 +21,13 @@ (hash-set! table key new) new)))))))])) -(define (make-count!) - +(define (make-count!) (let ([state 0]) - (lambda () (begin0 state (set! state (add1 state))))) - #; - (let ([ch (make-channel)]) - (thread (lambda () (let loop ([n 0]) (channel-put ch n) (loop (add1 n))))) - (lambda () (channel-get ch)))) - -(provide #;count! #;all-count! union-count!) + (lambda () (begin0 state (set! state (add1 state)))))) (define count! (make-count!)) -(define union-count! (make-count!)) -(define all-count! (make-count!)) (define id-count! (make-count!)) - - (define identifier-table (make-module-identifier-mapping)) (define (hash-id id) diff --git a/collects/typed-scheme/rep/rep-utils.ss b/collects/typed-scheme/rep/rep-utils.ss index de7ae4316b..414797700d 100644 --- a/collects/typed-scheme/rep/rep-utils.ss +++ b/collects/typed-scheme/rep/rep-utils.ss @@ -12,12 +12,14 @@ scheme/list stxclass/util scheme/match - stxclass + (except-in syntax/parse id identifier keyword) scheme/base syntax/struct syntax/stx scheme/contract - (utils utils))) + (rename-in (except-in (utils utils stxclass-util) bytes byte-regexp regexp byte-pregexp #;pregexp) + [id* id] + [keyword* keyword]))) (provide == defintern hash-id (for-syntax fold-target)) @@ -65,34 +67,36 @@ #:with e #'#'ex)) (lambda (stx) (syntax-parse stx - [(dform nm:id flds:idlist (~or [[#:key key-expr:expr]] #:opt - [[#:intern intern?:expr]] #:opt - [[#:frees . frees:frees-pat]] #:opt - [[#:fold-rhs fold-rhs:fold-pat]] #:opt - [[#:contract cnt:expr]] #:opt - [no-provide?:no-provide-kw] #:opt) ...) + [(dform nm:id flds:idlist (~or + (~optional [#:key key-expr:expr]) + (~optional [#:intern intern?:expr]) + (~optional [#:frees . frees:frees-pat]) + (~optional [#:fold-rhs fold-rhs:fold-pat]) + (~optional [#:contract cnt:expr]) + (~optional no-provide?:no-provide-kw)) ...) (with-syntax* ([ex (mk-id #'nm #'nm ":")] [fold-name (mk-id #f #'nm "-fold")] - [kw-stx (string->keyword (symbol->string #'nm.datum))] + [kw-stx (string->keyword (symbol->string (attribute nm.datum)))] [parent par] [(s:ty maker pred acc ...) (build-struct-names #'nm (syntax->list #'flds.fs) #f #t #'nm)] [*maker (mk-id #'nm "*" #'nm)] [**maker (mk-id #'nm "**" #'nm)] [*maker-cnt (if enable-contracts? - (or #'cnt #'(flds.cnt ... . -> . pred)) + (or (attribute cnt) #'(flds.cnt ... . -> . pred)) #'any/c)] [ht-stx ht-stx] - [bfs-fold-rhs (cond [#'fold-rhs #`(procedure-rename - (lambda () #,#'fold-rhs.e) - 'fold-name)] + [bfs-fold-rhs (cond [(attribute fold-rhs) + #`(procedure-rename + (lambda () #,#'fold-rhs.e) + 'fold-name)] ;; otherwise we assume that everything is a type, ;; and recur on all the arguments [else #'(procedure-rename (lambda () #`(*maker (#,type-rec-id flds.i) ...)) 'fold-name)])] - [provides (if #'no-provide? + [provides (if (attribute no-provide?) #'(begin) #`(begin (provide #;nm ex pred acc ...) @@ -100,18 +104,18 @@ [intern (let ([mk (lambda (int) (if key? - #`(defintern (**maker . flds.fs) maker #,int #:extra-arg key-expr) + #`(defintern (**maker . flds.fs) maker #,int #:extra-arg #,(attribute key-expr)) #`(defintern (**maker . flds.fs) maker #,int)))]) (syntax-parse #'flds.fs - [_ #:when #'intern? + [_ #:fail-unless (attribute intern?) #f (mk #'intern?)] [() (mk #'#f)] [(f) (mk #'f)] [_ (mk #'(list . flds.fs))]))] [(ign-pats ...) (if key? #'(_ _) #'(_))] - [frees-def (if #'frees #'frees.def #'(begin))] + [frees-def (if (attribute frees) #'frees.def #'(begin))] [frees - (with-syntax ([(f1 f2) (if #'frees + (with-syntax ([(f1 f2) (if (attribute frees) #'(frees.f1 frees.f2) (list (combiner #'free-vars* #'flds.fs) (combiner #'free-idxs* #'flds.fs)))]) @@ -168,7 +172,7 @@ (define-syntax-class clause (pattern (k:keyword #:matcher mtch pats ... e:expr) - #:with kw #'k.datum + #:with kw (attribute k.datum) #:with val (list #'mtch (syntax/loc this-syntax (pats ...)) (lambda () #'e) @@ -188,13 +192,13 @@ (define-syntax-class (keyword-in kws) #:attributes (datum) (pattern k:keyword - #:when (memq #'k.datum kws) - #:with datum #'k.datum)) + #:fail-unless (memq (attribute k.datum) kws) #f + #:with datum (attribute k.datum))) (define-syntax-class (sized-list kws) #:description (format "keyword expr pairs matching with keywords in the list ~a" kws) - (pattern ((~or [k e:expr]) ...) + (pattern ((~or (~seq k e:expr)) ...) #:declare k (keyword-in kws) - #:when (equal? (length (attribute k.datum)) (length (remove-duplicates (attribute k.datum)))) + #:fail-unless (equal? (length (attribute k.datum)) (length (remove-duplicates (attribute k.datum)))) #f #:with mapping (for/hash ([k* (attribute k.datum)] [e* (attribute e)]) (values k* e*)) @@ -225,26 +229,32 @@ #:attributes (i lower-s first-letter key? (fld-names 1)) #:transparent (pattern i:id - #:with lower-s (string-downcase (symbol->string #'i.datum)) + #:with lower-s (string-downcase (symbol->string (attribute i.datum))) #:with (fld-names ...) default-flds #:with key? #'#f #:with first-letter (string-ref #'lower-s 0)) (pattern [i:id #:d d-name:id] #:with (fld-names ...) default-flds - #:with lower-s (string-downcase (symbol->string #'i.datum)) + #:with lower-s (string-downcase (symbol->string (attribute i.datum))) #:with key? #'#f - #:with first-letter (symbol->string #'d-name.datum)) + #:with first-letter (symbol->string (attribute d-name.datum))) (pattern [i:id #:key] #:with (fld-names ...) (datum->syntax #f (append (syntax->list default-flds) (syntax->list #'(key)))) - #:with lower-s (string-downcase (symbol->string #'i.datum)) + #:with lower-s (string-downcase (symbol->string (attribute i.datum))) #:with key? #'#t #:with first-letter (string-ref #'lower-s 0))) (define-syntax-class type-name #:transparent - (pattern :type-name-base + #:attributes (i lower-s first-letter key? (fld-names 1) name keyword tmp-rec-id case printer ht rec-id d-id pred? (accs 1)) + (pattern tnb:type-name-base + #:with i #'tnb.i + #:with lower-s (attribute tnb.lower-s) + #:with first-letter (attribute tnb.first-letter) + #:with key? #'tnb.key? + #:with (fld-names ...) #'(tnb.fld-names ...) #:with name #'i - #:with keyword (string->keyword (symbol->string (syntax-e #'i))) + #:with keyword (datum->syntax #f (string->keyword (symbol->string (syntax-e #'i)))) #:with tmp-rec-id (generate-temporary) #:with case (mk-id #'i #'lower-s "-case") #:with printer (mk-id #'i "print-" #'lower-s "*") diff --git a/collects/typed-scheme/typecheck/find-annotation.ss b/collects/typed-scheme/typecheck/find-annotation.ss index d10889be66..0f94823fa2 100644 --- a/collects/typed-scheme/typecheck/find-annotation.ss +++ b/collects/typed-scheme/typecheck/find-annotation.ss @@ -1,6 +1,6 @@ #lang scheme/base -(require "../utils/utils.ss" stxclass +(require "../utils/utils.ss" syntax/parse scheme/contract (rep type-rep) (private type-annotation)) @@ -53,7 +53,7 @@ [c:lv-clause #:with (#%plain-app reverse n:id) #'c.e #:with (v) #'(c.v ...) - #:when (free-identifier=? name #'n) + #:fail-unless (free-identifier=? name #'n) #f (type-annotation #'v)] [_ #f])) (syntax-parse stx diff --git a/collects/typed-scheme/typecheck/tc-app.ss b/collects/typed-scheme/typecheck/tc-app.ss index e1565965b9..1896ed0d95 100644 --- a/collects/typed-scheme/typecheck/tc-app.ss +++ b/collects/typed-scheme/typecheck/tc-app.ss @@ -3,8 +3,13 @@ (require (rename-in "../utils/utils.ss" [infer r:infer]) "signatures.ss" "tc-metafunctions.ss" "tc-app-helper.ss" "find-annotation.ss" - stxclass scheme/match mzlib/trace scheme/list - (for-syntax stxclass scheme/base) + syntax/parse scheme/match mzlib/trace scheme/list + ;; fixme - don't need to be bound in this phase - only to make syntax/parse happy + scheme/bool + (only-in scheme/private/class-internal make-object do-make-object) + (only-in '#%kernel [apply k:apply]) + ;; end fixme + (for-syntax syntax/parse scheme/base (utils tc-utils)) (private type-annotation) (types utils abbrev union subtype resolve convenience) (utils tc-utils) @@ -14,7 +19,7 @@ (r:infer infer) (for-template (only-in '#%kernel [apply k:apply]) - "internal-forms.ss" scheme/base + "internal-forms.ss" scheme/base scheme/bool (only-in scheme/private/class-internal make-object do-make-object))) (import tc-expr^ tc-lambda^ tc-dots^ tc-let^) @@ -417,12 +422,12 @@ (ret ts fs os))])] ;; special case for keywords [(#%plain-app - (#%plain-app cpce s:kp fn kpe kws num) + (#%plain-app cpce s-kp fn kpe kws num) kw-list (#%plain-app list . kw-arg-list) . pos-args) #:declare cpce (id-from 'checked-procedure-check-and-extract 'scheme/private/kw) - #:declare s:kp (id-from 'struct:keyword-procedure 'scheme/private/kw) + #:declare s-kp (id-from 'struct:keyword-procedure 'scheme/private/kw) #:declare kpe (id-from 'keyword-procedure-extract 'scheme/private/kw) (match (tc-expr #'fn) [(tc-result1: (Function: arities)) @@ -431,9 +436,9 @@ "Cannot apply expression of type ~a, since it is not a function type" t)])] ;; even more special case for match [(#%plain-app (letrec-values ([(lp) (#%plain-lambda args . body)]) lp*) . actuals) - #:when expected - #:when (not (andmap type-annotation (syntax->list #'args))) - #:when (free-identifier=? #'lp #'lp*) + #:fail-unless expected #f + #:fail-unless (not (andmap type-annotation (syntax->list #'args))) #f + #:fail-unless (free-identifier=? #'lp #'lp*) #f (let-loop-check form #'lp #'actuals #'args #'body expected)] ;; special cases for classes [(#%plain-app make-object cl . args) @@ -442,11 +447,11 @@ (check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...))] ;; ormap/andmap of ... argument [(#%plain-app or/andmap:id f arg) - #:when (or (free-identifier=? #'or/andmap #'ormap) - (free-identifier=? #'or/andmap #'andmap)) - #:when (with-handlers ([exn:fail? (lambda _ #f)]) - (tc/dots #'arg) - #t) + #:fail-unless (or (free-identifier=? #'or/andmap #'ormap) + (free-identifier=? #'or/andmap #'andmap)) #f + #:fail-unless (with-handlers ([exn:fail? (lambda _ #f)]) + (tc/dots #'arg) + #t) #f (let-values ([(ty bound) (tc/dots #'arg)]) (parameterize ([current-tvars (extend-env (list bound) (list (make-DottedBoth (make-F bound))) @@ -493,18 +498,18 @@ (ret (foldr make-Pair last tys)))] ;; inference for ((lambda [(#%plain-app (#%plain-lambda (x ...) . body) args ...) - #:when (= (length (syntax->list #'(x ...))) - (length (syntax->list #'(args ...)))) + #:fail-unless (= (length (syntax->list #'(x ...))) + (length (syntax->list #'(args ...)))) #f (tc/let-values #'((x) ...) #'(args ...) #'body #'(let-values ([(x) args] ...) . body) expected)] ;; inference for ((lambda with dotted rest [(#%plain-app (#%plain-lambda (x ... . rst:id) . body) args ...) - #:when (<= (length (syntax->list #'(x ...))) - (length (syntax->list #'(args ...)))) + #:fail-unless (<= (length (syntax->list #'(x ...))) + (length (syntax->list #'(args ...)))) #f ;; FIXME - remove this restriction - doesn't work because the annotation ;; on rst is not a normal annotation, may have * or ... - #:when (not (type-annotation #'rst)) + #:fail-unless (not (type-annotation #'rst)) #f (let-values ([(fixed-args varargs) (split-at (syntax->list #'(args ...)) (length (syntax->list #'(x ...))))]) (with-syntax ([(fixed-args ...) fixed-args] [varg #`(#%plain-app list #,@varargs)]) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss index b92a1b5f20..44addceaa0 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.ss +++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss @@ -8,7 +8,7 @@ (types utils convenience union subtype) (private-in parse-type type-annotation) (rep type-rep) - (utils tc-utils stxclass-util) + (except-in (utils tc-utils stxclass-util) define-pred-stxclass 3d atom byte-pregexp byte-regexp regexp bytes) (env lexical-env) (only-in (env type-environments) lookup current-tvars extend-env) scheme/private/class-internal diff --git a/collects/typed-scheme/typecheck/tc-let-unit.ss b/collects/typed-scheme/typecheck/tc-let-unit.ss index 32d7e217a2..1ecf796b21 100644 --- a/collects/typed-scheme/typecheck/tc-let-unit.ss +++ b/collects/typed-scheme/typecheck/tc-let-unit.ss @@ -8,7 +8,7 @@ syntax/free-vars mzlib/trace scheme/match - syntax/kerncase stxclass + syntax/kerncase syntax/parse (for-template scheme/base "internal-forms.ss")) @@ -92,7 +92,7 @@ (define ((tc-expr-t/maybe-expected expected) e) (syntax-parse e #:literals (#%plain-lambda) [(#%plain-lambda () _) - #:when (and expected (syntax-property e 'typechecker:called-in-tail-position)) + #:fail-unless (and expected (syntax-property e 'typechecker:called-in-tail-position)) #f (tc-expr/check e (ret (-> (tc-results->values expected))))] [_ (tc-expr e)])) diff --git a/collects/typed-scheme/types/abbrev.ss b/collects/typed-scheme/types/abbrev.ss index 875da545f3..44425df7ae 100644 --- a/collects/typed-scheme/types/abbrev.ss +++ b/collects/typed-scheme/types/abbrev.ss @@ -9,7 +9,7 @@ scheme/match scheme/promise (prefix-in c: scheme/contract) - (for-syntax scheme/base stxclass) + (for-syntax scheme/base syntax/parse) (for-template scheme/base scheme/contract scheme/tcp)) (provide (all-defined-out) @@ -160,7 +160,7 @@ (define-syntax (->* stx) (define-syntax-class c - (pattern x:id #:when (eq? ': (syntax-e #'x)))) + (pattern x:id #:fail-unless (eq? ': (syntax-e #'x)) #f)) (syntax-parse stx [(_ dom rng) #'(make-Function (list (make-arr* dom rng)))] @@ -177,7 +177,7 @@ (define-syntax (-> stx) (define-syntax-class c - (pattern x:id #:when (eq? ': (syntax-e #'x)))) + (pattern x:id #:fail-unless (eq? ': (syntax-e #'x)) #f)) (syntax-parse stx [(_ dom ... rng _:c filters _:c objects) #'(->* (list dom ...) rng : filters : objects)] @@ -216,7 +216,7 @@ (define-syntax (->key stx) (syntax-parse stx - [(_ ty:expr ... (~or (k:keyword kty:expr opt:boolean)) ... rng) + [(_ ty:expr ... (~seq k:keyword kty:expr opt:boolean) ... rng) #'(make-Function (list (make-arr* (list ty ...) diff --git a/collects/typed-scheme/types/convenience.ss b/collects/typed-scheme/types/convenience.ss index b7c0b47092..9f19bd6751 100644 --- a/collects/typed-scheme/types/convenience.ss +++ b/collects/typed-scheme/types/convenience.ss @@ -1,15 +1,11 @@ #lang scheme/base -(require "../utils/utils.ss") - -(require (rep type-rep filter-rep object-rep) +(require "../utils/utils.ss" + (rep type-rep filter-rep object-rep) (utils tc-utils) "abbrev.ss" (types comparison printer union subtype utils) - scheme/list - scheme/match - scheme/promise - (for-syntax stxclass) - (for-syntax scheme/base) + scheme/list scheme/match scheme/promise + (for-syntax syntax/parse scheme/base) (for-template scheme/base)) (provide (all-defined-out) diff --git a/collects/typed-scheme/types/subtype.ss b/collects/typed-scheme/types/subtype.ss index d3ca0ef079..909e22dbec 100644 --- a/collects/typed-scheme/types/subtype.ss +++ b/collects/typed-scheme/types/subtype.ss @@ -1,14 +1,13 @@ #lang scheme/base -(require "../utils/utils.ss") - -(require (rep type-rep filter-rep object-rep rep-utils) +(require "../utils/utils.ss" + (rep type-rep filter-rep object-rep rep-utils) (utils tc-utils) (types utils comparison resolve abbrev) (env type-name-env) (only-in (infer infer-dummy) unify) scheme/match mzlib/trace - (for-syntax scheme/base stxclass)) + (for-syntax scheme/base syntax/parse)) ;; exn representing failure of subtyping ;; s,t both types diff --git a/collects/typed-scheme/types/utils.ss b/collects/typed-scheme/types/utils.ss index 2bbf161965..affbc2343d 100644 --- a/collects/typed-scheme/types/utils.ss +++ b/collects/typed-scheme/types/utils.ss @@ -9,7 +9,7 @@ scheme/list mzlib/trace scheme/contract - (for-syntax scheme/base stxclass)) + (for-syntax scheme/base syntax/parse)) (provide fv fv/list substitute diff --git a/collects/typed-scheme/utils/stxclass-util.ss b/collects/typed-scheme/utils/stxclass-util.ss index c1c2ce27c4..893851d743 100644 --- a/collects/typed-scheme/utils/stxclass-util.ss +++ b/collects/typed-scheme/utils/stxclass-util.ss @@ -1,8 +1,9 @@ #lang scheme/base -(require syntax/parse (for-syntax syntax/parse scheme/base stxclass/util)) +(require (except-in syntax/parse id keyword) (for-syntax syntax/parse scheme/base stxclass/util)) -(provide (except-out (all-defined-out) define-pred-stxclass)) +(provide (except-out (all-defined-out) id keyword) + (rename-out [id id*] [keyword keyword*])) (define-syntax (parse/get stx) (syntax-parse stx @@ -27,12 +28,15 @@ #:fail-unless (pred #'datum) #f)) (define-syntax-rule (define-pred-stxclass name pred) - (define-syntax-class name #:attributes () + (define-syntax-class name #:attributes (datum) (pattern x - #:fail-unless (pred (syntax-e #'x)) #f))) + #:fail-unless (pred (syntax-e #'x)) #f + #:with datum (syntax-e #'x)))) (define-pred-stxclass atom atom?) (define-pred-stxclass byte-pregexp byte-pregexp?) (define-pred-stxclass byte-regexp byte-regexp?) (define-pred-stxclass regexp regexp?) (define-pred-stxclass bytes bytes?) +(define-pred-stxclass id symbol?) +(define-pred-stxclass keyword keyword?) diff --git a/collects/typed-scheme/utils/tc-utils.ss b/collects/typed-scheme/utils/tc-utils.ss index 33e3a263d6..6c431e8d65 100644 --- a/collects/typed-scheme/utils/tc-utils.ss +++ b/collects/typed-scheme/utils/tc-utils.ss @@ -6,7 +6,7 @@ don't depend on any other portion of the system |# (provide (all-defined-out)) -(require "syntax-traversal.ss" stxclass (for-syntax scheme/base stxclass) scheme/match) +(require "syntax-traversal.ss" syntax/parse (for-syntax scheme/base syntax/parse) scheme/match) ;; a parameter representing the original location of the syntax being currently checked (define current-orig-stx (make-parameter #'here)) @@ -181,4 +181,4 @@ don't depend on any other portion of the system (define-syntax-class (id-from sym mod) (pattern i:id - #:when (id-from? #'i sym mod))) + #:fail-unless (id-from? #'i sym mod) #f)) diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss index c722a6213e..276f6d3350 100644 --- a/collects/typed-scheme/utils/utils.ss +++ b/collects/typed-scheme/utils/utils.ss @@ -5,10 +5,10 @@ This file is for utilities that are of general interest, at least theoretically. |# -(require (for-syntax scheme/base stxclass scheme/string) +(require (for-syntax scheme/base syntax/parse scheme/string) scheme/contract mzlib/plt-match scheme/require-syntax scheme/provide-syntax mzlib/struct scheme/unit - (except-in stxclass id)) + (except-in syntax/parse id)) (provide with-syntax* syntax-map start-timing do-time reverse-begin printf/log with-logging-to-file log-file-name == @@ -286,7 +286,7 @@ at least theoretically. #:literals () #:attributes (i) (pattern [rename out:id in:id cnt:expr] - #:when (eq? (syntax-e #'rename) 'rename) + #:fail-unless (eq? (syntax-e #'rename) 'rename) #f #:with i #'(rename-out [out in])) (pattern [i:id cnt:expr])) (syntax-parse stx