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

rewrote uses of mzlib/contract into racket/contract

Browse Source 
(and other minor rackety when the occasion arose)
This commit is contained in:
Robby Findler 2011-03-31 18:21:11 -05:00
parent 44193bda4c
commit e8eea05afc
4 changed files with 39 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/mrlib/cache-image-snip.rkt
View File

@ -1,10 +1,11 @@
(module cache-image-snip mzscheme #lang racket/base
(require racket/draw (require racket/draw
racket/snip racket/snip
mzlib/class racket/class
mzlib/string racket/contract
mzlib/contract racket/promise
mzlib/list) (for-syntax racket/base)
mzlib/string)
(provide cache-image-snip% (provide cache-image-snip%
cache-image-snip-class% cache-image-snip-class%
@ -274,12 +275,12 @@
(= (vector-ref v1 (- i 1)) (vector-ref v2 (- i 1))))) (= (vector-ref v1 (- i 1)) (vector-ref v2 (- i 1)))))
(loop (- i 4))))))) (loop (- i 4)))))))
(define image-snip-cache (make-hash-table 'weak)) (define image-snip-cache (make-weak-hasheq))
;; coerce-to-cache-image-snip : image -> (is-a?/c cache-image-snip%) ;; coerce-to-cache-image-snip : image -> (is-a?/c cache-image-snip%)
(define (coerce-to-cache-image-snip snp) (define (coerce-to-cache-image-snip snp)
(cond (cond
[(is-a? snp cache-image-snip%) snp] [(is-a? snp cache-image-snip%) snp]
[(hash-table-get image-snip-cache snp (λ () #f)) => values] [(hash-ref image-snip-cache snp (λ () #f)) => values]
[(is-a? snp image-snip%) [(is-a? snp image-snip%)
(let* ([bmp (send snp get-bitmap)] (let* ([bmp (send snp get-bitmap)]
[cis [cis
@ -303,7 +304,7 @@
(bitmap->mask bmp) (bitmap->mask bmp)
(floor (/ w 2)) (floor (/ w 2))
(floor (/ h 2))))))]) (floor (/ h 2))))))])
(hash-table-put! image-snip-cache snp cis) (hash-set! image-snip-cache snp cis)
cis)] cis)]
[else snp])) [else snp]))
@ -829,8 +830,8 @@ for b3, we have:
(define bitmap-size/c (and/c integer? exact? (between/c 1 10000))) (define bitmap-size/c (and/c integer? exact? (between/c 1 10000)))
(provide/contract (provide/contract
[overlay-bitmap (argb? (and/c integer? exact?) [overlay-bitmap (argb? exact-integer?
(and/c integer? exact?) exact-integer?
(is-a?/c bitmap%) (is-a?/c bitmap%)
(is-a?/c bitmap%) (is-a?/c bitmap%)
. -> . . -> .
@ -839,10 +840,10 @@ for b3, we have:
[flatten-bitmap ((is-a?/c bitmap%) . -> . (is-a?/c bitmap%))] [flatten-bitmap ((is-a?/c bitmap%) . -> . (is-a?/c bitmap%))]
[argb->cache-image-snip (argb? number? number? . -> . (is-a?/c cache-image-snip%))] [argb->cache-image-snip (argb? number? number? . -> . (is-a?/c cache-image-snip%))]
[argb->bitmap (argb? . -> . (or/c false/c (is-a?/c bitmap%)))] [argb->bitmap (argb? . -> . (or/c #f (is-a?/c bitmap%)))]
[argb? (any/c . -> . boolean?)] [argb? (any/c . -> . boolean?)]
[make-argb ((vectorof (integer-in 0 255)) exact-nonnegative-integer? exact-nonnegative-integer? . -> . argb?)] [make-argb ((vectorof (integer-in 0 255)) exact-nonnegative-integer? exact-nonnegative-integer? . -> . argb?)]
[argb-vector (argb? . -> . (vectorof (integer-in 0 255)))] [argb-vector (argb? . -> . (vectorof (integer-in 0 255)))]
[argb-width (argb? . -> . exact-nonnegative-integer?)] [argb-width (argb? . -> . exact-nonnegative-integer?)]
[argb-height (argb? . -> . exact-nonnegative-integer?)])) [argb-height (argb? . -> . exact-nonnegative-integer?)])

7
collects/mzlib/cml.rkt
View File

@ -1,6 +1,5 @@
#lang racket/base
(module cml mzscheme (require racket/contract)
(require mzlib/contract)
(define (spawn thunk) (define (spawn thunk)
(thread/suspend-to-kill thunk)) (thread/suspend-to-kill thunk))
@ -32,5 +31,5 @@
(thread-done-evt (thread? . -> . evt?)) (thread-done-evt (thread? . -> . evt?))
(current-time (-> number?)) (current-time (-> number?))
(time-evt (real? . -> . evt?)))) (time-evt (real? . -> . evt?)))

23
collects/mzlib/integer-set.rkt
View File

@ -1,6 +1,6 @@
(module integer-set mzscheme (module integer-set mzscheme
(require (all-except mzlib/list merge) (require (all-except mzlib/list merge)
mzlib/contract) racket/contract)
#;(define-syntax test-block #;(define-syntax test-block
(syntax-rules () (syntax-rules ()
@ -22,9 +22,6 @@
;; one number between them. ;; one number between them.
(define-struct integer-set (contents)) (define-struct integer-set (contents))
(define (int? x)
(and (integer? x) (exact? x)))
;; well-formed-set? : X -> bool ;; well-formed-set? : X -> bool
(define (well-formed-set? x) (define (well-formed-set? x)
(let loop ((set x) (let loop ((set x)
@ -33,8 +30,8 @@
(null? set) (null? set)
(and (pair? set) (and (pair? set)
(pair? (car set)) (pair? (car set))
(int? (caar set)) (exact-integer? (caar set))
(int? (cdar set)) (exact-integer? (cdar set))
(< (add1 current-num) (caar set)) (< (add1 current-num) (caar set))
(<= (caar set) (cdar set)) (<= (caar set) (cdar set))
(loop (cdr set) (cdar set)))))) (loop (cdr set) (cdar set))))))
@ -429,22 +426,20 @@
(define (subset? s1 s2) (define (subset? s1 s2)
(subset?-helper (integer-set-contents s1) (integer-set-contents s2))) (subset?-helper (integer-set-contents s1) (integer-set-contents s2)))
(define int (flat-named-contract "exact-integer" int?))
(provide well-formed-set?) (provide well-formed-set?)
(provide/contract (struct integer-set ((contents (flat-named-contract "integer-set-list" well-formed-set?)))) (provide/contract (struct integer-set ((contents (flat-named-contract "integer-set-list" well-formed-set?))))
(make-range (case-> (-> integer-set?) (make-range
(int . -> . integer-set?) (->i () ((i exact-integer?) (j (i) (and/c exact-integer? (>=/c i)))) [res integer-set?]))
(((i int) (j (and/c int (>=/c i)))) . ->r . integer-set?)))
(rename merge union (integer-set? integer-set? . -> . integer-set?)) (rename merge union (integer-set? integer-set? . -> . integer-set?))
(split (integer-set? integer-set? . -> . (values integer-set? integer-set? integer-set?))) (split (integer-set? integer-set? . -> . (values integer-set? integer-set? integer-set?)))
(intersect (integer-set? integer-set? . -> . integer-set?)) (intersect (integer-set? integer-set? . -> . integer-set?))
(difference (integer-set? integer-set? . -> . integer-set?)) (difference (integer-set? integer-set? . -> . integer-set?))
(xor (integer-set? integer-set? . -> . integer-set?)) (xor (integer-set? integer-set? . -> . integer-set?))
(complement (((s integer-set?) (min int) (max (and/c int (>=/c min)))) . ->r . integer-set?)) (complement (->i ((s integer-set?) (min exact-integer?) (max (min) (and/c exact-integer? (>=/c min))))
(member? (int integer-set? . -> . any)) [res integer-set?]))
(get-integer (integer-set? . -> . (union false/c int))) (member? (exact-integer? integer-set? . -> . any))
(get-integer (integer-set? . -> . (or/c #f exact-integer?)))
(rename is-foldr foldr (any/c any/c integer-set? . -> . any)) (rename is-foldr foldr (any/c any/c integer-set? . -> . any))
(partition ((listof integer-set?) . -> . (listof integer-set?))) (partition ((listof integer-set?) . -> . (listof integer-set?)))
(card (integer-set? . -> . natural-number/c)) (card (integer-set? . -> . natural-number/c))

29
collects/net/url.rkt
View File

@ -1,7 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/unit (require racket/unit
scheme/contract racket/contract
(only-in mzlib/contract opt->)
"url-structs.ss" "url-structs.ss"
"url-sig.ss" "url-sig.ss"
"url-unit.ss" "url-unit.ss"
@ -20,18 +19,18 @@
(string->url ((or/c bytes? string?) . -> . url?)) (string->url ((or/c bytes? string?) . -> . url?))
(path->url ((or/c path-string? path-for-some-system?) . -> . url?)) (path->url ((or/c path-string? path-for-some-system?) . -> . url?))
(url->string (url? . -> . string?)) (url->string (url? . -> . string?))
(url->path ((url?) ((one-of/c 'unix 'windows)) . opt-> . path-for-some-system?)) (url->path (->* (url?) ((one-of/c 'unix 'windows)) path-for-some-system?))
(get-pure-port (opt-> (url?) ((listof string?)) input-port?)) (get-pure-port (->* (url?) ((listof string?)) input-port?))
(get-impure-port (opt-> (url?) ((listof string?)) input-port?)) (get-impure-port (->* (url?) ((listof string?)) input-port?))
(post-pure-port (opt-> (url? (or/c false/c bytes?)) ((listof string?)) input-port?)) (post-pure-port (->* (url? (or/c false/c bytes?)) ((listof string?)) input-port?))
(post-impure-port (opt-> (url? bytes?) ((listof string?)) input-port?)) (post-impure-port (->* (url? bytes?) ((listof string?)) input-port?))
(head-pure-port (opt-> (url?) ((listof string?)) input-port?)) (head-pure-port (->* (url?) ((listof string?)) input-port?))
(head-impure-port (opt-> (url?) ((listof string?)) input-port?)) (head-impure-port (->* (url?) ((listof string?)) input-port?))
(delete-pure-port (opt-> (url?) ((listof string?)) input-port?)) (delete-pure-port (->* (url?) ((listof string?)) input-port?))
(delete-impure-port (opt-> (url?) ((listof string?)) input-port?)) (delete-impure-port (->* (url?) ((listof string?)) input-port?))
(put-pure-port (opt-> (url? (or/c false/c bytes?)) ((listof string?)) input-port?)) (put-pure-port (->* (url? (or/c false/c bytes?)) ((listof string?)) input-port?))
(put-impure-port (opt-> (url? bytes?) ((listof string?)) input-port?)) (put-impure-port (->* (url? bytes?) ((listof string?)) input-port?))
(display-pure-port (input-port? . -> . void?)) (display-pure-port (input-port? . -> . void?))
(purify-port (input-port? . -> . string?)) (purify-port (input-port? . -> . string?))
(netscape/string->url (string? . -> . url?)) (netscape/string->url (string? . -> . url?))