From 077e6da2cb5af1b2e3c540043eea92dd65549d00 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 30 Mar 2016 10:49:09 -0500 Subject: [PATCH] `->2` -> `->` --- racket/collects/racket/contract/base.rkt | 4 +-- .../contract/private/arrow-val-first.rkt | 30 +++++++++---------- .../racket/contract/private/case-arrow.rkt | 6 +--- .../racket/contract/private/object.rkt | 10 +++---- .../racket/contract/private/opters.rkt | 1 - .../racket/contract/private/provide.rkt | 22 +++++++------- racket/collects/racket/contract/region.rkt | 6 ++-- .../collects/racket/private/class-c-old.rkt | 6 ++-- 8 files changed, 40 insertions(+), 45 deletions(-) diff --git a/racket/collects/racket/contract/base.rkt b/racket/collects/racket/contract/base.rkt index 4f2fabbb4c..b432f057a4 100644 --- a/racket/collects/racket/contract/base.rkt +++ b/racket/collects/racket/contract/base.rkt @@ -44,7 +44,7 @@ blame-add-range-context blame-add-nth-arg-context - (rename-out [->2 ->] [->*2 ->*]) + -> ->* dynamic->* predicate/c @@ -154,5 +154,5 @@ ;; If the argument is a procedure, it must be a thunk, and it is applied. Otherwise ;; the argument is simply the value to return. (define failure-result/c - (if/c procedure? (->2 any) any/c)) + (if/c procedure? (-> any) any/c)) diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt index d0bb2201c5..1a82ba4037 100644 --- a/racket/collects/racket/contract/private/arrow-val-first.rkt +++ b/racket/collects/racket/contract/private/arrow-val-first.rkt @@ -13,24 +13,24 @@ racket/stxparam (prefix-in arrow: "arrow-common.rkt")) -(provide ->2 ->*2 - ->2-internal ->*2-internal ; for ->m and ->*m +(provide (rename-out [->/c ->]) ->* + ->-internal ->*-internal ; for ->m and ->*m base->? base->-name base->-rngs base->-doms dynamic->* arity-checking-wrapper (for-syntax parse-leftover->*) - (for-syntax ->2-arity-check-only->? - ->2*-arity-check-only->? + (for-syntax ->-arity-check-only->? + ->*-arity-check-only->? ->-valid-app-shapes ->*-valid-app-shapes) (rename-out [-predicate/c predicate/c])) -(define-for-syntax (->2-arity-check-only->? stx) +(define-for-syntax (->-arity-check-only->? stx) (syntax-case stx (any any/c) [(_ any/c ... any) (- (length (syntax->list stx)) 2)] [_ #f])) -(define-for-syntax (->2*-arity-check-only->? stx) +(define-for-syntax (->*-arity-check-only->? stx) (syntax-case stx (any any/c) [(_ (any/c ...) any) (length (syntax->list (cadr (syntax->list stx))))] [(_ (any/c ...) () any) (length (syntax->list (cadr (syntax->list stx))))] @@ -641,16 +641,16 @@ (map syntax->datum kwds) '()))])) -(define-syntax (->2 stx) +(define-syntax (->/c stx) (syntax-case stx () [(_ . args) (let () #`(syntax-parameterize ((arrow:making-a-method #f)) #,(quasisyntax/loc stx - (->2-internal -> . args))))])) + (->-internal -> . args))))])) -(define-syntax (->2-internal stx*) +(define-syntax (->-internal stx*) (syntax-case stx* () [(_ orig-> args ... rng) (let () @@ -739,7 +739,7 @@ this->*)] let-bindings)))]))) -(define-for-syntax (parse->*2 stx this->*) +(define-for-syntax (parse->* stx this->*) (syntax-case stx () [(_ (raw-mandatory-dom ...) . other) (let () @@ -823,7 +823,7 @@ (define-values (man-dom man-dom-kwds man-lets opt-dom opt-dom-kwds opt-lets rest-ctc pre pre/desc rng-ctcs post post/desc) - (parse->*2 stx this->*)) + (parse->* stx this->*)) (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds] [((optional-dom-kwd optional-dom-kwd-ctc) ...) opt-dom-kwds]) (valid-app-shapes-from-man/opts (length (syntax->list man-dom)) @@ -832,21 +832,21 @@ (syntax->datum #'(mandatory-dom-kwd ...)) (syntax->datum #'(optional-dom-kwd ...))))) -(define-syntax (->*2 stx) +(define-syntax (->* stx) (syntax-case stx () [(_ . args) #`(syntax-parameterize ((arrow:making-a-method #f)) #,(quasisyntax/loc stx - (->*2-internal ->* . args)))])) + (->*-internal ->* . args)))])) -(define-syntax (->*2-internal stx*) +(define-syntax (->*-internal stx*) (define stx (syntax-case stx* () [(_ orig->* . args) (syntax/loc stx* (orig->* . args))])) (define this->* (gensym 'this->*)) (define-values (man-dom man-dom-kwds man-lets opt-dom opt-dom-kwds opt-lets rest-ctc pre pre/desc rng-ctcs post post/desc) - (parse->*2 stx this->*)) + (parse->* stx this->*)) (with-syntax ([(mandatory-dom ...) man-dom] [((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds] [(mandatory-let-bindings ...) man-lets] diff --git a/racket/collects/racket/contract/private/case-arrow.rkt b/racket/collects/racket/contract/private/case-arrow.rkt index 01f2b7d773..bcb4917197 100644 --- a/racket/collects/racket/contract/private/case-arrow.rkt +++ b/racket/collects/racket/contract/private/case-arrow.rkt @@ -38,15 +38,11 @@ [x #'(x)])) (define-for-syntax (separate-out-doms/rst/rng stx case) - (syntax-case case (-> ->2) + (syntax-case case (->) [(-> doms ... #:rest rst rng) (values #'(doms ...) #'rst (parse-rng stx #'rng))] - [(->2 doms ... #:rest rst rng) - (values #'(doms ...) #'rst (parse-rng stx #'rng))] [(-> doms ... rng) (values #'(doms ...) #f (parse-rng stx #'rng))] - [(->2 doms ... rng) - (values #'(doms ...) #f (parse-rng stx #'rng))] [(x y ...) (raise-syntax-error #f "expected ->" stx #'x)] [_ diff --git a/racket/collects/racket/contract/private/object.rkt b/racket/collects/racket/contract/private/object.rkt index c581717489..83e87ee1d6 100644 --- a/racket/collects/racket/contract/private/object.rkt +++ b/racket/collects/racket/contract/private/object.rkt @@ -96,11 +96,11 @@ (define-syntax (fun->meth stx) (syntax-case stx () [(_ ctc) - (syntax-case #'ctc (->2 ->*2 ->d ->i case->) - [(->2 . args) #'(->m . args)] - [(->*2 . args) #'(->*m . args)] - [(->d . args) #'(->dm . args)] - [(->i . args) #'ctc] ; ->i doesn't reset the `making-a-method` syntax parameter + (syntax-case #'ctc (-> ->* ->d ->i case->) + [(-> . args) #'(->m . args)] + [(->* . args) #'(->*m . args)] + [(->d . args) #'(->dm . args)] + [(->i . args) #'ctc] ; ->i doesn't reset the `making-a-method` syntax parameter [(case-> case ...) #'ctc])])) ; neither does case-> (define (build-object-contract methods method-ctcs fields field-ctcs) diff --git a/racket/collects/racket/contract/private/opters.rkt b/racket/collects/racket/contract/private/opters.rkt index fe9d529203..0db98e3566 100644 --- a/racket/collects/racket/contract/private/opters.rkt +++ b/racket/collects/racket/contract/private/opters.rkt @@ -728,7 +728,6 @@ (opt/unknown opt/i opt/info stx))))])) (define/opter (-> opt/i opt/info stx) (->-opter opt/i opt/info stx)) -(define/opter (->2 opt/i opt/info stx) (->-opter opt/i opt/info stx)) (define opt->/c-cm-key (gensym 'opt->/c-cm-key)) diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt index d51e161718..6c1b095294 100644 --- a/racket/collects/racket/contract/private/provide.rkt +++ b/racket/collects/racket/contract/private/provide.rkt @@ -279,12 +279,12 @@ contract-error-name pos-module-source) (define-values (arrow? the-valid-app-shapes) - (syntax-case ctrct (->2 ->*2 ->i) - [(->2 . _) - (not (->2-arity-check-only->? ctrct)) + (syntax-case ctrct (-> ->* ->i) + [(-> . _) + (not (->-arity-check-only->? ctrct)) (values #t (->-valid-app-shapes ctrct))] - [(->*2 . _) - (values (not (->2*-arity-check-only->? ctrct)) + [(->* . _) + (values (not (->*-arity-check-only->? ctrct)) (->*-valid-app-shapes ctrct))] [(->i . _) (values #t (->i-valid-app-shapes ctrct))] [_ (values #f #f)])) @@ -990,24 +990,24 @@ (with-syntax ([(field-contract-ids ...) field-contract-ids] [predicate-id predicate-id]) (syntax/loc stx - (->2 field-contract-ids ... - predicate-id)))) + (-> field-contract-ids ... + predicate-id)))) ;; build-selector-contract : syntax syntax -> syntax ;; constructs the contract for a selector (define (build-selector-contract struct-name predicate-id field-contract-id) (with-syntax ([field-contract-id field-contract-id] [predicate-id predicate-id]) - (syntax (->2 predicate-id field-contract-id)))) + (syntax (-> predicate-id field-contract-id)))) ;; build-mutator-contract : syntax syntax -> syntax ;; constructs the contract for a selector (define (build-mutator-contract struct-name predicate-id field-contract-id) (with-syntax ([field-contract-id field-contract-id] [predicate-id predicate-id]) - (syntax (->2 predicate-id - field-contract-id - void?)))) + (syntax (-> predicate-id + field-contract-id + void?)))) ;; code-for-one-poly-id : syntax -> syntax (define (code-for-one-poly-id x x-gen poly) diff --git a/racket/collects/racket/contract/region.rkt b/racket/collects/racket/contract/region.rkt index d98ca8ce92..847a55b7ab 100644 --- a/racket/collects/racket/contract/region.rkt +++ b/racket/collects/racket/contract/region.rkt @@ -174,11 +174,11 @@ (for/list ([finfo field-infos]) (let ([field-ctc (field-info-ctc finfo)]) (cons (quasisyntax/loc stx - (->2 #,pred #,field-ctc)) + (-> #,pred #,field-ctc)) (if (field-info-mutable? finfo) (list (quasisyntax/loc stx - (->2 #,pred #,field-ctc void?))) + (-> #,pred #,field-ctc void?))) null))))))) (define (check-field f ctc) @@ -434,7 +434,7 @@ (define-struct/derived orig name (field ...) omit-stx-def ... kwds ... - #:guard (contract (->2 super-contract ... non-auto-contracts ... symbol? any) + #:guard (contract (-> super-contract ... non-auto-contracts ... symbol? any) guard (current-contract-region) blame-id (quote maker) diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt index 246a3b5b74..7ff85f4129 100644 --- a/racket/collects/racket/private/class-c-old.rkt +++ b/racket/collects/racket/private/class-c-old.rkt @@ -9,7 +9,7 @@ "../contract/base.rkt" "../contract/combinator.rkt" (only-in "../contract/private/arrow-common.rkt" making-a-method method-contract?) - (only-in "../contract/private/arrow-val-first.rkt" ->2-internal ->*2-internal)) + (only-in "../contract/private/arrow-val-first.rkt" ->-internal ->*-internal)) (provide make-class/c class/c-late-neg-proj blame-add-method-context blame-add-field-context blame-add-init-context @@ -26,10 +26,10 @@ ;; Shorthand contracts that treat the implicit object argument as if it were ;; contracted with any/c. (define-syntax-rule (->m . stx) - (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->2-internal ->m . stx))) + (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->-internal ->m . stx))) (define-syntax-rule (->*m . stx) - (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->*2-internal ->*m . stx))) + (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->*-internal ->*m . stx))) (define-syntax-rule (case->m . stx) (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (case-> . stx)))