rewrote uses of mzlib/contract into racket/contract
(and other minor rackety when the occasion arose)
This commit is contained in:
Robby Findler
parent
44193bda4c
commit
e8eea05afc
|
|
@ -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?)])
|
||||
|
|
|
|||
|
|
@ -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?)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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?))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user