suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changed the ->d contracts to ->i contracts

Browse Source
This commit is contained in:
Robby Findler 2010-09-09 14:16:56 -05:00
parent 711fe50641
commit d419e8c12a
12 changed files with 80 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/drracket/private/language-object-contract.rkt
View File

@ -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?)

8
collects/drracket/tool-lib.rkt
View File

@ -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

30
collects/framework/gui-utils.rkt
View File

@ -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.})

16
collects/framework/main.rkt
View File

@ -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]

28
collects/mrlib/name-message.rkt
View File

@ -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))

16
collects/redex/pict.rkt
View File

@ -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?)])])

4
collects/typed-scheme/rep/filter-rep.rkt
View File

@ -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)])

8
collects/typed-scheme/rep/type-rep.rkt
View File

@ -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)]

16
collects/typed-scheme/types/utils.rkt
View File

@ -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

10
collects/unstable/class.rkt
View File

@ -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)

6
collects/unstable/dict.rkt
View File

@ -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)

6
collects/unstable/hash.rkt
View File

@ -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)