From d419e8c12a554d660a65198dd102bc03e01c93a8 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 9 Sep 2010 14:16:56 -0500 Subject: [PATCH] changed the ->d contracts to ->i contracts --- .../private/language-object-contract.rkt | 5 ++-- collects/drracket/tool-lib.rkt | 8 ++--- collects/framework/gui-utils.rkt | 30 +++++++++++-------- collects/framework/main.rkt | 16 +++++----- collects/mrlib/name-message.rkt | 28 ++++++++--------- collects/redex/pict.rkt | 16 ++++++---- collects/typed-scheme/rep/filter-rep.rkt | 4 +-- collects/typed-scheme/rep/type-rep.rkt | 8 ++--- collects/typed-scheme/types/utils.rkt | 16 +++++----- collects/unstable/class.rkt | 10 +++---- collects/unstable/dict.rkt | 6 ++-- collects/unstable/hash.rkt | 6 ++-- 12 files changed, 80 insertions(+), 73 deletions(-) diff --git a/collects/drracket/private/language-object-contract.rkt b/collects/drracket/private/language-object-contract.rkt index 61d6209fcd..ba650c66dc 100644 --- a/collects/drracket/private/language-object-contract.rkt +++ b/collects/drracket/private/language-object-contract.rkt @@ -77,10 +77,9 @@ (unmarshall-settings (-> printable/c any)) (capability-value - (->d ([s (and/c symbol? + (->i ([s (and/c symbol? drracket:language:capability-registered?)]) - () - [res (drracket:language:get-capability-contract s)]))))]) + [res (s) (drracket:language:get-capability-contract s)]))))]) #`(begin (define id (reconstitute #,ctc provide?)) #,@(if (syntax-e #'provide?) diff --git a/collects/drracket/tool-lib.rkt b/collects/drracket/tool-lib.rkt index 96130b2c16..bc48c6835e 100644 --- a/collects/drracket/tool-lib.rkt +++ b/collects/drracket/tool-lib.rkt @@ -1154,9 +1154,9 @@ all of the names in the tools library, for use defining keybindings (proc-doc drracket:language:register-capability - (->d ([s symbol?] + (->i ([s symbol?] [the-contract contract?] - [default the-contract]) + [default (the-contract) the-contract]) () [res void?]) @{Registers a new capability with a default value for each language @@ -1242,9 +1242,9 @@ all of the names in the tools library, for use defining keybindings has been called with @racket[s].}) (proc-doc drracket:language:get-capability-default - (->d ([s (and/c symbol? drracket:language:capability-registered?)]) + (->i ([s (and/c symbol? drracket:language:capability-registered?)]) () - [res (drracket:language:get-capability-contract s)]) + [res (s) (drracket:language:get-capability-contract s)]) @{Returns the default for a particular capability.}) (proc-doc/names drracket:language:get-capability-contract diff --git a/collects/framework/gui-utils.rkt b/collects/framework/gui-utils.rkt index c50be8fb68..7c89d95cf1 100644 --- a/collects/framework/gui-utils.rkt +++ b/collects/framework/gui-utils.rkt @@ -294,34 +294,38 @@ (provide/doc (proc-doc gui-utils:trim-string - (->d ([str string?][size (and/c number? positive?)]) + (->i ([str string?] + [size (and/c number? positive?)]) () - [_ (and/c string? - (λ (str) - ((string-length str) . <= . size)))]) + [res (size) + (and/c string? + (λ (str) + ((string-length str) . <= . size)))]) @{Constructs a string whose size is less than @scheme[size] by trimming the @scheme[str] and inserting an ellispses into it.}) (proc-doc gui-utils:quote-literal-label - (->d ([str string?]) + (->i ([str string?]) () - [_ (and/c string? - (lambda (str) - ((string-length str) . <= . 200)))]) + [res (str) + (and/c string? + (lambda (str) + ((string-length str) . <= . 200)))]) @{Constructs a string whose ampersand characters are escaped; the label is also trimmed to <= 200 characters.}) (proc-doc gui-utils:format-literal-label - (->d ([str string?]) + (->i ([str string?]) () - #:rest rest (listof any/c) - [_ (and/c string? - (lambda (str) - ((string-length str) . <= . 200)))]) + #:rest [rest (listof any/c)] + [res (str) + (and/c string? + (lambda (str) + ((string-length str) . <= . 200)))]) @{Formats a string whose ampersand characters are mk-escaped; the label is also trimmed to <= 200 mk-characters.}) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index 71a01f8974..e7d90cb3e6 100644 --- a/collects/framework/main.rkt +++ b/collects/framework/main.rkt @@ -195,15 +195,15 @@ (proc-doc/names preferences:add-panel (-> (or/c string? (cons/c string? (listof string?))) - (->d ([parent (is-a?/c area-container-window<%>)]) + (->i ([parent (is-a?/c area-container-window<%>)]) () - [_ - (let ([old-children (send parent get-children)]) - (and/c (is-a?/c area-container-window<%>) - (λ (child) - (andmap eq? - (append old-children (list child)) - (send parent get-children)))))]) + [_ (parent) + (let ([old-children (send parent get-children)]) + (and/c (is-a?/c area-container-window<%>) + (λ (child) + (andmap eq? + (append old-children (list child)) + (send parent get-children)))))]) void?) (labels f) @{@scheme[preferences:add-preference-panel] adds the result of @scheme[f] diff --git a/collects/mrlib/name-message.rkt b/collects/mrlib/name-message.rkt index d1ad4ccff2..cdb5fbdbc6 100644 --- a/collects/mrlib/name-message.rkt +++ b/collects/mrlib/name-message.rkt @@ -1,11 +1,23 @@ #lang racket/gui +(define (get-left-side-padding) (+ button-label-inset circle-spacer)) +(define button-label-inset 1) +(define black-color (make-object color% "BLACK")) + +(define triangle-width 10) +(define triangle-height 14) +(define triangle-color (make-object color% 50 50 50)) + +(define border-inset 1) +(define circle-spacer 4) +(define rrect-spacer 3) + (provide/contract [get-left-side-padding (-> number?)] [pad-xywh (-> number? number? (>=/c 0) (>=/c 0) (values number? number? (>=/c 0) (>=/c 0)))] [draw-button-label - (->d ([dc (is-a?/c dc<%>)] + (->i ([dc (is-a?/c dc<%>)] [label (or/c false/c string?)] [x number?] [y number?] @@ -15,7 +27,7 @@ [grabbed? boolean?] [button-label-font (is-a?/c font%)] [bkg-color (or/c false/c (is-a?/c color%) string?)]) - #:pre-cond + #:pre (w h) (w . > . (- h (* 2 border-inset))) [result void?])] @@ -214,18 +226,6 @@ (stretchable-height #f) (send (get-dc) set-smoothing 'aligned))) -(define (get-left-side-padding) (+ button-label-inset circle-spacer)) -(define button-label-inset 1) -(define black-color (make-object color% "BLACK")) - -(define triangle-width 10) -(define triangle-height 14) -(define triangle-color (make-object color% 50 50 50)) - -(define border-inset 1) -(define circle-spacer 4) -(define rrect-spacer 3) - (define (offset-color color offset-one) (make-object color% (offset-one (send color red)) diff --git a/collects/redex/pict.rkt b/collects/redex/pict.rkt index 0d636a934f..7152103ca3 100644 --- a/collects/redex/pict.rkt +++ b/collects/redex/pict.rkt @@ -19,10 +19,12 @@ (provide/contract [render-reduction-relation - (->d ([rel reduction-relation?]) + (->i ([rel reduction-relation?]) ([file (or/c false/c path-string?)] - #:style [style reduction-rule-style/c]) - [result (if (path-string? file) + #:style + [style reduction-rule-style/c]) + [result (file) + (if (path-string? file) void? pict?)])] [reduction-relation->pict (->* (reduction-relation?) @@ -34,10 +36,12 @@ (#:nts (or/c false/c (listof (or/c string? symbol?)))) pict?)] [render-language - (->d ([lang compiled-lang?]) + (->i ([lang compiled-lang?]) ([file (or/c false/c path-string?)] - #:nts [nts (or/c false/c (listof (or/c string? symbol?)))]) - [result (if (path-string? file) + #:nts + [nts (or/c false/c (listof (or/c string? symbol?)))]) + [result (file) + (if (path-string? file) void? pict?)])]) diff --git a/collects/typed-scheme/rep/filter-rep.rkt b/collects/typed-scheme/rep/filter-rep.rkt index 1fbd695245..5b65d050a6 100644 --- a/collects/typed-scheme/rep/filter-rep.rkt +++ b/collects/typed-scheme/rep/filter-rep.rkt @@ -46,10 +46,10 @@ (combine-frees (map free-idxs* fs))]) (df FilterSet (thn els) - [#:contract (->d ([t any/c] + [#:contract (->i ([t any/c] [e any/c]) (#:syntax [stx #f]) - #:pre-cond + #:pre-cond (t e) (and (cond [(Bot? t) #t] [(Bot? e) (Top? t)] [else (Filter/c-predicate? t)]) diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt index 46793127f9..c9bb029c2f 100644 --- a/collects/typed-scheme/rep/type-rep.rkt +++ b/collects/typed-scheme/rep/type-rep.rkt @@ -149,8 +149,8 @@ ;; n is how many variables are bound here ;; body is a Scope (dt Poly (n body) #:no-provide - [#:contract (->d ([n natural-number/c] - [body (scope-depth n)]) + [#:contract (->i ([n natural-number/c] + [body (n) (scope-depth n)]) (#:syntax [stx (or/c #f syntax?)]) [result Poly?])] [#:frees (λ (f) (f body))] @@ -162,8 +162,8 @@ ;; there are n-1 'normal' vars and 1 ... var ;; body is a Scope (dt PolyDots (n body) #:no-provide - [#:contract (->d ([n natural-number/c] - [body (scope-depth n)]) + [#:contract (->i ([n natural-number/c] + [body (n) (scope-depth n)]) (#:syntax [stx (or/c #f syntax?)]) [result PolyDots?])] [#:key (Type-key body)] diff --git a/collects/typed-scheme/types/utils.rkt b/collects/typed-scheme/types/utils.rkt index af9780bf3f..5b1670b440 100644 --- a/collects/typed-scheme/types/utils.rkt +++ b/collects/typed-scheme/types/utils.rkt @@ -137,16 +137,16 @@ (p/c [ret - (->d ([t (or/c Type/c (listof Type/c))]) - ([f (if (list? t) - (listof FilterSet/c) - FilterSet/c)] - [o (if (list? t) - (listof Object?) - Object?)] + (->i ([t (or/c Type/c (listof Type/c))]) + ([f (t) (if (list? t) + (listof FilterSet/c) + FilterSet/c)] + [o (t) (if (list? t) + (listof Object?) + Object?)] [dty Type/c] [dbound symbol?]) - [_ tc-results?])]) + [res tc-results?])]) (define (combine-results tcs) (match tcs diff --git a/collects/unstable/class.rkt b/collects/unstable/class.rkt index 3b21a1d3d7..ae132abb3a 100644 --- a/collects/unstable/class.rkt +++ b/collects/unstable/class.rkt @@ -29,9 +29,9 @@ (syntax/loc stx (let* ([super-var super-in] ... [sub-var sub-out] ...) - (->d ([super (class-provides/c super-var ...)]) + (->i ([super (class-provides/c super-var ...)]) () - [_ (class-provides/c super sub-var ...)]))))])) + [res (super) (class-provides/c super sub-var ...)]))))])) (define-syntax (send+ stx) (syntax-case stx () @@ -65,10 +65,10 @@ [class-provides/c (->* [] [] #:rest (listof class-or-interface/c) flat-contract?)] [ensure-interface - (->d ([the-interface interface?] - [the-mixin (mixin-provides/c [] [the-interface])] + (->i ([the-interface interface?] + [the-mixin (the-interface) (mixin-provides/c [] [the-interface])] [the-class class?]) () - [_ (class-provides/c the-class the-interface)])]) + [res (the-class the-interface) (class-provides/c the-class the-interface)])]) (provide mixin-provides/c send+ send-each) diff --git a/collects/unstable/dict.rkt b/collects/unstable/dict.rkt index 6cef0db5f0..93598b5bc2 100644 --- a/collects/unstable/dict.rkt +++ b/collects/unstable/dict.rkt @@ -281,9 +281,9 @@ [dict-ref/default (-> dict? any/c any/c any/c)] [dict-ref/failure (-> dict? any/c (-> any/c) any/c)] [dict-ref/check - (->d ([table dict?] [key any/c]) () - #:pre-cond (dict-has-key? table key) - [_ any/c])] + (->i ([table dict?] [key any/c]) () + #:pre (table key) (dict-has-key? table key) + [res any/c])] [dict-union (->* [(and/c dict? dict-can-functional-set?)] [#:combine (-> any/c any/c any/c) diff --git a/collects/unstable/hash.rkt b/collects/unstable/hash.rkt index a757d131db..34bcc14293 100644 --- a/collects/unstable/hash.rkt +++ b/collects/unstable/hash.rkt @@ -56,9 +56,9 @@ [hash-ref/default (-> hash? any/c any/c any/c)] [hash-ref/failure (-> hash? any/c (-> any/c) any/c)] [hash-ref/check - (->d ([table hash?] [key any/c]) () - #:pre-cond (hash-has-key? table key) - [_ any/c])] + (->i ([table hash?] [key any/c]) () + #:pre (table key) (hash-has-key? table key) + [res any/c])] [hash-union (->* [(and/c hash? immutable?)] [#:combine (-> any/c any/c any/c)