diff --git a/collects/mrlib/cache-image-snip.rkt b/collects/mrlib/cache-image-snip.rkt index 88f4b2cefe..6ef8b9169a 100644 --- a/collects/mrlib/cache-image-snip.rkt +++ b/collects/mrlib/cache-image-snip.rkt @@ -1,10 +1,11 @@ -(module cache-image-snip mzscheme +#lang racket/base (require racket/draw racket/snip - mzlib/class - mzlib/string - mzlib/contract - mzlib/list) + racket/class + racket/contract + racket/promise + (for-syntax racket/base) + mzlib/string) (provide cache-image-snip% cache-image-snip-class% @@ -274,12 +275,12 @@ (= (vector-ref v1 (- i 1)) (vector-ref v2 (- i 1))))) (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%) (define (coerce-to-cache-image-snip snp) (cond [(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%) (let* ([bmp (send snp get-bitmap)] [cis @@ -303,7 +304,7 @@ (bitmap->mask bmp) (floor (/ w 2)) (floor (/ h 2))))))]) - (hash-table-put! image-snip-cache snp cis) + (hash-set! image-snip-cache snp cis) cis)] [else snp])) @@ -829,8 +830,8 @@ for b3, we have: (define bitmap-size/c (and/c integer? exact? (between/c 1 10000))) (provide/contract - [overlay-bitmap (argb? (and/c integer? exact?) - (and/c integer? exact?) + [overlay-bitmap (argb? exact-integer? + exact-integer? (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%))] [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?)] [make-argb ((vectorof (integer-in 0 255)) exact-nonnegative-integer? exact-nonnegative-integer? . -> . argb?)] [argb-vector (argb? . -> . (vectorof (integer-in 0 255)))] [argb-width (argb? . -> . exact-nonnegative-integer?)] - [argb-height (argb? . -> . exact-nonnegative-integer?)])) + [argb-height (argb? . -> . exact-nonnegative-integer?)]) diff --git a/collects/mzlib/cml.rkt b/collects/mzlib/cml.rkt index 9097021bd3..c618562033 100644 --- a/collects/mzlib/cml.rkt +++ b/collects/mzlib/cml.rkt @@ -1,6 +1,5 @@ - -(module cml mzscheme - (require mzlib/contract) +#lang racket/base +(require racket/contract) (define (spawn thunk) (thread/suspend-to-kill thunk)) @@ -32,5 +31,5 @@ (thread-done-evt (thread? . -> . evt?)) (current-time (-> number?)) - (time-evt (real? . -> . evt?)))) + (time-evt (real? . -> . evt?))) diff --git a/collects/mzlib/integer-set.rkt b/collects/mzlib/integer-set.rkt index 10e8b69554..6c14cb1271 100644 --- a/collects/mzlib/integer-set.rkt +++ b/collects/mzlib/integer-set.rkt @@ -1,6 +1,6 @@ (module integer-set mzscheme (require (all-except mzlib/list merge) - mzlib/contract) + racket/contract) #;(define-syntax test-block (syntax-rules () @@ -22,9 +22,6 @@ ;; one number between them. (define-struct integer-set (contents)) - (define (int? x) - (and (integer? x) (exact? x))) - ;; well-formed-set? : X -> bool (define (well-formed-set? x) (let loop ((set x) @@ -33,8 +30,8 @@ (null? set) (and (pair? set) (pair? (car set)) - (int? (caar set)) - (int? (cdar set)) + (exact-integer? (caar set)) + (exact-integer? (cdar set)) (< (add1 current-num) (caar set)) (<= (caar set) (cdar set)) (loop (cdr set) (cdar set)))))) @@ -429,22 +426,20 @@ (define (subset? s1 s2) (subset?-helper (integer-set-contents s1) (integer-set-contents s2))) - (define int (flat-named-contract "exact-integer" int?)) - (provide well-formed-set?) (provide/contract (struct integer-set ((contents (flat-named-contract "integer-set-list" well-formed-set?)))) - (make-range (case-> (-> integer-set?) - (int . -> . integer-set?) - (((i int) (j (and/c int (>=/c i)))) . ->r . integer-set?))) + (make-range + (->i () ((i exact-integer?) (j (i) (and/c exact-integer? (>=/c i)))) [res integer-set?])) (rename merge union (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?)) (difference (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?)) - (member? (int integer-set? . -> . any)) - (get-integer (integer-set? . -> . (union false/c int))) + (complement (->i ((s integer-set?) (min exact-integer?) (max (min) (and/c exact-integer? (>=/c min)))) + [res integer-set?])) + (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)) (partition ((listof integer-set?) . -> . (listof integer-set?))) (card (integer-set? . -> . natural-number/c)) diff --git a/collects/net/url.rkt b/collects/net/url.rkt index 8068fe6f22..c20a157696 100644 --- a/collects/net/url.rkt +++ b/collects/net/url.rkt @@ -1,7 +1,6 @@ -#lang scheme/base -(require scheme/unit - scheme/contract - (only-in mzlib/contract opt->) +#lang racket/base +(require racket/unit + racket/contract "url-structs.ss" "url-sig.ss" "url-unit.ss" @@ -20,18 +19,18 @@ (string->url ((or/c bytes? string?) . -> . url?)) (path->url ((or/c path-string? path-for-some-system?) . -> . url?)) (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-impure-port (opt-> (url?) ((listof string?)) input-port?)) - (post-pure-port (opt-> (url? (or/c false/c bytes?)) ((listof string?)) input-port?)) - (post-impure-port (opt-> (url? bytes?) ((listof string?)) input-port?)) - (head-pure-port (opt-> (url?) ((listof string?)) input-port?)) - (head-impure-port (opt-> (url?) ((listof string?)) input-port?)) - (delete-pure-port (opt-> (url?) ((listof string?)) input-port?)) - (delete-impure-port (opt-> (url?) ((listof string?)) input-port?)) - (put-pure-port (opt-> (url? (or/c false/c bytes?)) ((listof string?)) input-port?)) - (put-impure-port (opt-> (url? bytes?) ((listof string?)) input-port?)) + (get-pure-port (->* (url?) ((listof string?)) input-port?)) + (get-impure-port (->* (url?) ((listof string?)) input-port?)) + (post-pure-port (->* (url? (or/c false/c bytes?)) ((listof string?)) input-port?)) + (post-impure-port (->* (url? bytes?) ((listof string?)) input-port?)) + (head-pure-port (->* (url?) ((listof string?)) input-port?)) + (head-impure-port (->* (url?) ((listof string?)) input-port?)) + (delete-pure-port (->* (url?) ((listof string?)) input-port?)) + (delete-impure-port (->* (url?) ((listof string?)) input-port?)) + (put-pure-port (->* (url? (or/c false/c bytes?)) ((listof string?)) input-port?)) + (put-impure-port (->* (url? bytes?) ((listof string?)) input-port?)) (display-pure-port (input-port? . -> . void?)) (purify-port (input-port? . -> . string?)) (netscape/string->url (string? . -> . url?))