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

removed unused modules and code from unstable

Browse Source
This commit is contained in:
Ryan Culpepper 2011-04-11 21:13:09 -06:00
parent f867fea327
commit ccc70fca73
36 changed files with 106 additions and 2304 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/racket/benchmarks/shootout/run.rkt
View File

@ -1,8 +1,8 @@
(module run mzscheme (module run mzscheme
(require (only scheme/runtime-path define-runtime-path) (require (only scheme/runtime-path define-runtime-path)
racket/port racket/port
mzlib/kw unstable/port
unstable/port) mzlib/kw)
(define input-map (define input-map
`( `(
("ackermann" "12") ("ackermann" "12")

18
collects/tests/unstable/byte-counting-port.rkt
View File

@ -1,18 +0,0 @@
#lang racket
(require racket/port
tests/eli-tester)
(define name (gensym))
(define cp (open-output-nowhere name))
(define (test-cp cp)
(for/fold ([l 0])
([i (in-range 100)])
(define n (random 25))
(test
(file-position cp) => l
(write-bytes (make-bytes n) cp))
(+ l n)))
(test
(object-name cp) => name
(test-cp cp)
(test-cp (open-output-nowhere)))

94
collects/tests/unstable/class.rkt
View File

@ -1,94 +0,0 @@
#lang racket
(require rackunit rackunit/text-ui unstable/class "helpers.rkt")
(run-tests
(test-suite "class.ss"
(test-suite "Predicates and Contracts"
(test-suite "class-or-interface/c"
(test (check-ok (with/c class-or-interface/c object%)))
(test (check-ok (with/c class-or-interface/c (interface ()))))
(test (check-bad (with/c class-or-interface/c (new object%)))))
(test-suite "object-provides/c"
(test-ok (with/c (object-provides/c) (new object%)))
(test-ok (define c% (class object% (super-new)))
(with/c (object-provides/c c%) (new c%)))
(test-ok (define i<%> (interface ()))
(define c% (class* object% (i<%>) (super-new)))
(with/c (object-provides/c i<%>) (new c%)))
(test-bad (define c% (class object% (super-new)))
(with/c (object-provides/c c%) (new object%)))
(test-bad (define i<%> (interface ()))
(with/c (object-provides/c i<%>) (new object%)))
(test-bad (with/c (object-provides/c) object%)))
(test-suite "class-provides/c"
(test-ok (with/c (class-provides/c) object%))
(test-ok (define c% (class object% (super-new)))
(with/c (class-provides/c c%) c%))
(test-ok (define c% (class object% (super-new)))
(with/c (class-provides/c object%) c%))
(test-ok (define i<%> (interface ()))
(define c% (class* object% (i<%>) (super-new)))
(with/c (class-provides/c i<%>) c%))
(test-bad (define c% (class object% (super-new)))
(with/c (class-provides/c c%) object%))
(test-bad (define i<%> (interface ()))
(with/c (class-provides/c i<%>) object%)))
(test-suite "mixin-provides/c"
(test-ok ((with/c (mixin-provides/c [] []) values) object%))
(test-bad (define i<%> (interface ()))
((with/c (mixin-provides/c [i<%>] []) values) object%))
(test-bad (define i<%> (interface ()))
((with/c (mixin-provides/c [i<%>] []) values) object%))))
(test-suite "Mixins"
(test-suite "ensure-interface"
(test-case "implementation unchanged"
(let* ([i<%> (interface ())]
[c% (class* object% (i<%>) (super-new))]
[mx (lambda (parent%) (class* parent% (i<%>) (super-new)))])
(check-eq? (ensure-interface i<%> mx c%) c%)))
(test-case "non-implementation subclassed"
(let* ([i<%> (interface ())]
[c% (class object% (super-new))]
[mx (lambda (parent%) (class* parent% (i<%>) (super-new)))]
[result (ensure-interface i<%> mx c%)])
(check-pred class? result)
(check subclass? result c%)
(check implementation? result i<%>)))))
(test-suite "Messages"
(test-suite "send+"
(test-case "no messages"
(let* ([o (new object%)])
(check-eq? (send+ o) o)))
(test-case "multiple messages"
(let* ([c% (class object%
(super-new)
(init-field count)
(define/public (add n) (set! count (+ count n)))
(define/public (get) count))]
[o (new c% [count 0])])
(check-eq? (send+ o [add 1] [add 2]) o)
(check = (send o get) 3))))
(test-suite "send-each"
(test-case "counter"
(let* ([c% (class object%
(super-new)
(init-field count)
(define/public (add n) (set! count (+ count n)))
(define/public (get) count))]
[o1 (new c% [count 1])]
[o2 (new c% [count 2])]
[o3 (new c% [count 3])])
(send-each (list o1 o2 o3) add 3)
(check-equal? (list (send o1 get) (send o2 get) (send o3 get))
(list 4 5 6))))))))

62
collects/tests/unstable/dict.rkt
View File

@ -15,46 +15,6 @@
(run-tests (run-tests
(test-suite "dict.ss" (test-suite "dict.ss"
(test-suite "Constructors"
(test-suite "empty-dict"
(test (check/dict (empty-dict) '()))
(test (check/dict (empty-dict #:mutable? #t) '()))
(test (check/dict (empty-dict #:weak? #t) '()))
(test (check/dict (empty-dict #:compare 'eqv) '())))
(test-suite "make-dict"
(test (check/dict (make-dict '([1 . a] [2 . b])) '([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:mutable? #t)
'([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:weak? #t)
'([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:compare 'eqv)
'([1 . a] [2 . b]))))
(test-suite "custom-dict"
(test (let* ([table (custom-dict = add1 sub1 #:mutable? #t)])
(dict-set! table 1 'a)
(dict-set! table 2 'b)
(check/dict table '([1 . a] [2 . b]))))))
(test-suite "Lookup"
(test-suite "dict-ref/check"
(test-ok (check-equal? (dict-ref/check '([1 . one] [2 . two]) 1) 'one))
(test-bad (dict-ref/check '([1 . one] [2 . two]) 3)))
(test-suite "dict-ref/identity"
(test-ok (check-equal? (dict-ref/identity '([1 . one] [2 . two]) 1)
'one))
(test-ok (check-equal? (dict-ref/identity '([1 . one] [2 . two]) 3) 3)))
(test-suite "dict-ref/default"
(test-ok (check-equal? (dict-ref/default '([1 . one] [2 . two]) 1 '?)
'one))
(test-ok (check-equal? (dict-ref/default '([1 . one] [2 . two]) 3 '?)
'?)))
(test-suite "dict-ref/failure"
(test-ok (define x 7)
(define (f) (set! x (+ x 1)) x)
(check-equal? (dict-ref/failure '([1 . one] [2 . two]) 1 f)
'one)
(check-equal? x 7)
(check-equal? (dict-ref/failure '([1 . one] [2 . two]) 3 f) 8)
(check-equal? x 8))))
(test-suite "Accessors" (test-suite "Accessors"
(test-suite "dict-empty?" (test-suite "dict-empty?"
(test (check-true (dict-empty? '()))) (test (check-true (dict-empty? '())))
@ -69,24 +29,4 @@
(dict-union! d '([3 . three] [4 . four])) (dict-union! d '([3 . three] [4 . four]))
(check-equal? (check-equal?
(hash-copy #hash([1 . one] [2 . two] [3 . three] [4 . four])) (hash-copy #hash([1 . one] [2 . two] [3 . three] [4 . four]))
d)))) d))))))
(test-suite "Property"
(test-suite "wrapped-dict-property"
(test
(let ()
(define (unwrap-table d) (table-dict d))
(define (wrap-table d) (make-table d))
(define (wrapped? d) (table? d))
(define-struct table [dict]
#:transparent
#:property prop:dict
(wrapped-dict-property
#:unwrap unwrap-table
#:wrap wrap-table
#:predicate wrapped?))
(check-true (dict? (make-table '([1 . a] [2 . b]))))
(check/dict (make-table '([1 . a] [2 . b])) '([1 . a] [2 . b]))
(check-equal? (dict-ref (make-table '([1 . a] [2 . b])) 1) 'a)
(let* ([s (dict-set (make-table '([1 . a] [2 . b])) 3 'c)])
(check-true (table? s))
(check/dict s '([1 . a] [2 . b] [3 . c])))))))))

31
collects/tests/unstable/list.rkt
View File

@ -7,3 +7,34 @@
(remf even? '(1 -2 3 4 -5)) => '(1 3 4 -5) (remf even? '(1 -2 3 4 -5)) => '(1 3 4 -5)
(remf (λ (x) #f) '(1 -2 3 4 -5)) => '(1 -2 3 4 -5)) (remf (λ (x) #f) '(1 -2 3 4 -5)) => '(1 -2 3 4 -5))
(require rackunit rackunit/text-ui)
(run-tests
(test-suite "unstable/list"
(test-suite "map2"
(test-case "numerator and denominator"
(let*-values ([(ns ds)
(map2
(lambda (r)
(values (numerator r) (denominator r)))
(list 1/2 3/4 5/6))])
(check-equal? (list ns ds) (list '(1 3 5) '(2 4 6))))))
(test-suite "map/values"
(test-case "complex numerator and denominator"
(let*-values ([(rns rds ins ids)
(map/values
4
(lambda (c)
(values (numerator (real-part c))
(denominator (real-part c))
(numerator (imag-part c))
(denominator (imag-part c))))
(list 1/2+3/4i 5/6+7/8i))])
(check-equal? (list rns rds ins ids)
(list '(1 5) '(2 6) '(3 7) '(4 8)))))
(test-case "multiple lists"
(let*-values ([(as bs cs)
(map/values 3 values '(1 2 3) '(4 5 6) '(7 8 9))])
(check-equal? as '(1 2 3))
(check-equal? bs '(4 5 6))
(check-equal? cs '(7 8 9)))))))

11
collects/tests/unstable/port.rkt
View File

@ -31,13 +31,4 @@
(make-srcloc 'string 1 0 1 0)) (make-srcloc 'string 1 0 1 0))
(read port) (read port)
(check-equal? (port->srcloc port 'here 1) (check-equal? (port->srcloc port 'here 1)
(make-srcloc 'here 2 2 4 1)))) (make-srcloc 'here 2 2 4 1))))))
(test-suite "read-available-bytes"
(test-ok (define-values [in out] (make-pipe))
(check-equal? (read-available-bytes in) #"")
(write-byte (char->integer #\c) out)
(check-equal? (read-available-bytes in) #"c")
(close-output-port out)
(check-equal? (read-available-bytes in) eof)))))

48
collects/tests/unstable/regexp.rkt
View File

@ -1,48 +0,0 @@
#lang racket
(require rackunit rackunit/text-ui unstable/regexp "helpers.rkt")
(define-syntax (regexp-test stx)
(syntax-case stx ()
[(_ pattern string result)
(syntax/loc stx
(test-suite (format "(regexp-match ~s ~s) = ~s" 'pattern 'string 'result)
(test-case "regexp"
(check-equal? (regexp-match (regexp pattern) string) result))
(test-case "pregexp"
(check-equal? (regexp-match (pregexp pattern) string) result))))]))
(run-tests
(test-suite "regexp.ss"
(test-suite "regexp-sequence"
(regexp-test (regexp-sequence) "a cat" (list ""))
(regexp-test (regexp-sequence "cat") "a cat" (list "cat"))
(regexp-test (regexp-sequence "hot" "dog") "a hotdog" (list "hotdog"))
(regexp-test (regexp-sequence "cat" "dog") "a cat" #f)
(regexp-test (regexp-sequence "cat" "dog") "a dog" #f)
(regexp-test (regexp-sequence "a" "b|c") "c" #f))
(test-suite "regexp-or"
(regexp-test (regexp-or "cat") "a cat" (list "cat"))
(regexp-test (regexp-or "cat" "dog") "a cat" (list "cat"))
(regexp-test (regexp-or "cat" "dog") "a dog" (list "dog")))
(test-suite "regexp-maybe"
(regexp-test (regexp-maybe "cat") "a dog" (list ""))
(regexp-test (regexp-maybe "cat") "catnap" (list "cat"))
(regexp-test (regexp-maybe "hot" "dog") "hotdog!" (list "hotdog"))
(regexp-test (regexp-maybe "hot" "dog") "a dog" (list "")))
(test-suite "regexp-star"
(regexp-test (regexp-star "a") "" (list ""))
(regexp-test (regexp-star "a") "aaa" (list "aaa"))
(regexp-test (regexp-star "ab") "abab" (list "abab"))
(regexp-test (regexp-star "a" "b") "abab" (list "abab"))
(regexp-test (regexp-star "a" "b") "aaaa" (list "")))
(test-suite "regexp-plus"
(regexp-test (regexp-plus "a") "" #f)
(regexp-test (regexp-plus "a") "aaa" (list "aaa"))
(regexp-test (regexp-plus "ab") "abab" (list "abab"))
(regexp-test (regexp-plus "a" "b") "abab" (list "abab"))
(regexp-test (regexp-plus "a" "b") "aaaa" #f))
(test-suite "regexp-multi"
(regexp-test (regexp-multi "^cat$") "ant\nbat\ncat\ndog" (list "cat")))
(test-suite "regexp-save"
(regexp-test (regexp-save "cat") "a cat" (list "cat" "cat")))))

133
collects/tests/unstable/text.rkt
View File

@ -1,133 +0,0 @@
#lang racket
(require rackunit rackunit/text-ui unstable/text "helpers.rkt")
(run-tests
(test-suite "text.ss"
(test-suite "text/c"
(test-ok (with/c text/c "text"))
(test-ok (with/c text/c #"text"))
(test-ok (with/c text/c 'text))
(test-ok (with/c text/c '#:text))
(test-ok (with/c text/c #'"text"))
(test-ok (with/c text/c #'#"text"))
(test-ok (with/c text/c #'text))
(test-ok (with/c text/c #'#:text))
(test-bad (with/c text/c '(not text))))
(test-suite "text?"
(test-case "accept string"
(check-pred text? "text"))
(test-case "accept byte string"
(check-pred text? #"text"))
(test-case "accept symbol"
(check-pred text? 'text))
(test-case "accept keyword"
(check-pred text? '#:text))
(test-case "accept string literal"
(check-pred text? #'"text"))
(test-case "accept byte string literal"
(check-pred text? #'#"text"))
(test-case "accept identifier"
(check-pred text? #'text))
(test-case "accept keyword literal"
(check-pred text? #'#:text))
(test-case "reject non-text"
(check-false (text? '(not text)))))
(test-suite "string-literal?"
(test-case "accept" (check-true (string-literal? #'"string")))
(test-case "reject" (check-false (string-literal? "string"))))
(test-suite "keyword-literal?"
(test-case "accept" (check-true (keyword-literal? #'#:keyword)))
(test-case "reject" (check-false (keyword-literal? '#:keyword))))
(test-suite "bytes-literal?"
(test-case "accept" (check-true (bytes-literal? #'#"bytes")))
(test-case "reject" (check-false (bytes-literal? #"bytes"))))
(test-suite "text=?"
(test-case "string = string"
(check text=? "abc" (string-copy "abc")))
(test-case "string != string"
(check-not text=? "abc" (string-copy "cba")))
(test-case "string = identifier"
(check text=? "car" #'car))
(test-case "string != identifier"
(check-not text=? "car" #'cdr))
(test-case "identifier = identifier, different bindings"
(check text=? #'car (datum->syntax #f 'car)))
(test-case "identifier != identifier, no bindings"
(check-not text=? #'UNBOUND (datum->syntax #f 'ALSO-UNBOUND))))
(test-suite "text<?"
(test-case "string < string"
(check text<? "abc" "def"))
(test-case "string !< string"
(check-not text<? "abc" "abc"))
(test-case "string < identifier"
(check text<? "abc" #'def))
(test-case "string !< identifier"
(check-not text<? "abc" #'abc)))
(test-suite "text<=?"
(test-case "string <= string"
(check text<=? "abc" "abc"))
(test-case "string !<= string"
(check-not text<=? "def" "abc"))
(test-case "string <= identifier"
(check text<=? "abc" #'abc))
(test-case "string !<= identifier"
(check-not text<=? "def" #'abc)))
(test-suite "text>?"
(test-case "string > string"
(check text>? "def" "abc"))
(test-case "string !> string"
(check-not text>? "abc" "abc"))
(test-case "string > identifier"
(check text>? "def" #'abc))
(test-case "string !> identifier"
(check-not text>? "abc" #'abc)))
(test-suite "text>=?"
(test-case "string >= string"
(check text>=? "abc" "abc"))
(test-case "string !>= string"
(check-not text>=? "abc" "def"))
(test-case "string >= identifier"
(check text>=? "abc" #'abc))
(test-case "string !>= identifier"
(check-not text>=? "abc" #'def)))
(test-suite "text->string"
(test-case "single" (check-equal? (text->string 'abc) "abc"))
(test-case "multiple" (check-equal? (text->string 'a "b" #'c) "abc")))
(test-suite "text->symbol"
(test-case "single" (check-equal? (text->symbol "abc") 'abc))
(test-case "multiple" (check-equal? (text->symbol 'a "b" #'c) 'abc)))
(test-suite "text->keyword"
(test-case "single" (check-equal? (text->keyword #'abc) '#:abc))
(test-case "multiple" (check-equal? (text->keyword 'a "b" #'c) '#:abc)))
(test-suite "text->bytes"
(test-case "single" (check-equal? (text->bytes "abc") #"abc"))
(test-case "multiple" (check-equal? (text->bytes 'a "b" #'c) #"abc")))
(test-suite "text->identifier"
(test-case "single, no context"
(check-equal? (syntax-e (text->identifier "abc")) 'abc))
(test-case "multiple w/ context"
(check bound-identifier=?
(text->identifier #:stx #'here 'a "b" #'c)
#'abc)))
(test-suite "text->string-literal"
(test-case "single"
(check-equal? (syntax-e (text->string-literal '#:abc)) "abc"))
(test-case "multiple"
(check-equal?
(syntax-e (text->string-literal #:stx #'here 'a "b" #'c))
"abc")))
(test-suite "text->keyword-literal"
(test-case "single"
(check-equal? (syntax-e (text->keyword-literal #"abc")) '#:abc))
(test-case "multiple"
(check-equal?
(syntax-e (text->keyword-literal #:stx #'here 'a "b" #'c))
'#:abc)))
(test-suite "text->bytes-literal"
(test-case "single"
(check-equal? (syntax-e (text->bytes-literal 'abc)) #"abc"))
(test-case "multiple"
(check-equal?
(syntax-e (text->bytes-literal #:stx #'here 'a "b" #'c))
#"abc")))))

60
collects/tests/unstable/values.rkt
View File

@ -1,60 +0,0 @@
#lang racket
(require rackunit rackunit/text-ui unstable/values "helpers.rkt")
(run-tests
(test-suite "values.ss"
(test-suite "map2"
(test-case "numerator and denominator"
(let*-values ([(ns ds)
(map2
(lambda (r)
(values (numerator r) (denominator r)))
(list 1/2 3/4 5/6))])
(check-equal? (list ns ds) (list '(1 3 5) '(2 4 6))))))
(test-suite "map/values"
(test-case "complex numerator and denominator"
(let*-values ([(rns rds ins ids)
(map/values
4
(lambda (c)
(values (numerator (real-part c))
(denominator (real-part c))
(numerator (imag-part c))
(denominator (imag-part c))))
(list 1/2+3/4i 5/6+7/8i))])
(check-equal? (list rns rds ins ids)
(list '(1 5) '(2 6) '(3 7) '(4 8)))))
(test-case "multiple lists"
(let*-values ([(as bs cs)
(map/values 3 values '(1 2 3) '(4 5 6) '(7 8 9))])
(check-equal? as '(1 2 3))
(check-equal? bs '(4 5 6))
(check-equal? cs '(7 8 9)))))
(test-suite "foldl/values"
(test-case "sum, product, and last"
(let*-values ([(sum prod last)
(foldl/values
(lambda (next sum prod last)
(values (+ next sum)
(* next prod)
next))
(list 0 1 #f)
(list 1 2 3 4))])
(check-equal? (list sum prod last)
(list 10 24 4)))))
(test-suite "foldr/values"
(test-case "sum, product, and last"
(let*-values ([(sum prod last)
(foldr/values
(lambda (next sum prod last)
(values (+ next sum)
(* next prod)
next))
(list 0 1 #f)
(list 1 2 3 4))])
(check-equal? (list sum prod last)
(list 10 24 1)))))
(test-suite "values->list"
(test-case "1 2 3 4"
(check-equal? (values->list (values 1 2 3 4)) (list 1 2 3 4))))))

16
collects/tests/unstable/web.rkt
View File

@ -1,16 +0,0 @@
#lang racket
(require rackunit rackunit/text-ui unstable/web "helpers.rkt")
(run-tests
(test-suite "web.ss"
(test-suite "css?"
(test-true "CSS" (css? '((foo (a b) (c d)) (bar (w x) (y z)))))
(test-false "not CSS" (css? '(a b c d))))
(test-suite "css/c"
(test-ok "CSS" (with/c css/c '((foo (a b) (c d)) (bar (w x) (y z)))))
(test-bad "not CSS" (with/c css/c '(a b c d))))
(test-suite "write-css")
(test-suite "write-xexpr")
(test-suite "create-stylesheet")
(test-suite "create-webpage")))

74
collects/unstable/class.rkt
View File

@ -1,74 +0,0 @@
#lang racket/base
(require racket/contract racket/class
(for-syntax racket/base))
(define class-or-interface/c (or/c class? interface?))
(define (subclass-or-implements/c class-or-iface)
(cond
[(class? class-or-iface) (subclass?/c class-or-iface)]
[(interface? class-or-iface) (implementation?/c class-or-iface)]
[else (error 'subclass-or-implements/c
"not a class or interface: ~s"
class-or-iface)]))
(define (object-provides/c . class-or-ifaces)
(apply and/c object? (map is-a?/c class-or-ifaces)))
(define (class-provides/c . class-or-ifaces)
(apply and/c class? (map subclass-or-implements/c class-or-ifaces)))
(define-syntax (mixin-provides/c stx)
(syntax-case stx ()
[(form (super-in ...)
(sub-out ...))
(with-syntax ([(super-var ...)
(generate-temporaries (syntax (super-in ...)))]
[(sub-var ...)
(generate-temporaries (syntax (sub-out ...)))])
(syntax/loc stx
(let* ([super-var super-in] ...
[sub-var sub-out] ...)
(->i ([super (class-provides/c super-var ...)])
()
[res (super) (class-provides/c super sub-var ...)]))))]))
(define-syntax (send+ stx)
(syntax-case stx ()
[(s+ expr clause ...)
(syntax/loc stx
(let* ([obj expr])
(send obj . clause) ...
obj))]))
(define-syntax (send-each stx)
(syntax-case stx ()
[(se objs-expr method arg-expr ...)
(with-syntax ([(arg-var ...) (generate-temporaries #'(arg-expr ...))])
(syntax/loc stx
(let ([objs-var objs-expr]
[arg-var arg-expr]
...)
(for-each (lambda (obj)
(send obj method arg-var ...))
objs-var))))]))
(define (ensure-interface iface<%> mx class%)
(if (implementation? class% iface<%>)
class%
(mx class%)))
(provide/contract
[class-or-interface/c flat-contract?]
[object-provides/c
(->* [] [] #:rest (listof class-or-interface/c) flat-contract?)]
[class-provides/c
(->* [] [] #:rest (listof class-or-interface/c) flat-contract?)]
[ensure-interface
(->i ([the-interface interface?]
[the-mixin (the-interface) (mixin-provides/c [] [the-interface])]
[the-class class?])
()
[res (the-class the-interface) (class-provides/c the-class the-interface)])])
(provide mixin-provides/c send+ send-each)

240
collects/unstable/dict.rkt
View File

@ -1,12 +1,6 @@
#lang racket/base #lang racket/base
(require racket/dict
(require racket/dict racket/match racket/contract unstable/contract) racket/contract)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; "Missing" Functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (dict-empty? dict) (define (dict-empty? dict)
(not (dict-iterate-first dict))) (not (dict-iterate-first dict)))
@ -15,118 +9,6 @@
;; make things worse, it's not even mentioned in the docs.) ;; make things worse, it's not even mentioned in the docs.)
;; Ryan: Fixed complexity. ;; Ryan: Fixed complexity.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Constructors
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (empty-dict #:weak? [weak? #f]
#:mutable? [mutable? weak?]
#:compare [compare 'equal])
(match* [mutable? weak? compare]
;; Immutable
([#f #f 'equal] (make-immutable-hash null))
([#f #f 'eqv] (make-immutable-hasheqv null))
([#f #f 'eq] (make-immutable-hasheq null))
;; Mutable
([#t #f 'equal] (make-hash))
([#t #f 'eqv] (make-hasheqv))
([#t #f 'eq] (make-hasheq))
;; Weak
([#t #t 'equal] (make-weak-hash))
([#t #t 'eqv] (make-weak-hash))
([#t #t 'eq] (make-weak-hash))
;; Impossible
([#f #t _] (error 'empty-set "cannot create an immutable weak hash"))))
;; Eli: What's the point in this? The whole dict thing is very similar
;; to an abstract class, and this code is essentially making a
;; constructor for the abstract class that decides to instantiate some
;; arbitrary subclass. Furthermore, since this arbitrary decision is
;; always going for a hash table, this whole function is nothing more
;; than a keyworded version of `make-hash-*'. (As a very obvious
;; example, if I have a mental model of alists, using this function
;; makes things much less efficient than just returning `null'.) This
;; is possibly something useful, but calling it `make-dict' is bogus.
;; Another evidence for this bogosity: the documentation for this
;; function says: "Constructs an empty >>hash table<<".
(define (make-dict dict
#:weak? [weak? #f]
#:mutable? [mutable? weak?]
#:compare [compare 'equal])
(let* ([MT (empty-dict #:mutable? mutable? #:weak? weak? #:compare compare)])
(if mutable?
(begin (dict-union! MT dict) MT)
(dict-union MT dict))))
;; Eli: Similar bogosity to the above. When I see `make-dict', I don't
;; think about a function that "Converts a given dictionary to a hash
;; table". If it's useful, then it should have a more straightforward
;; name, like `dict->hash'. Also, reusing `dict-union' is cute, but
;; makes it slower than it could be.
(define (custom-dict equiv?
[hash1 (lambda (x) 0)]
[hash2 (lambda (x) 0)]
#:weak? [weak? #f]
#:mutable? [mutable? weak?])
(match* [mutable? weak?]
([#f #f] (make-immutable-custom-hash equiv? hash1 hash2))
([#t #f] (make-custom-hash equiv? hash1 hash2))
([#t #t] (make-weak-custom-hash equiv? hash1 hash2))
([#f #t] (error 'custom-set "cannot create an immutable weak hash"))))
;; Eli: Again, same bogosity comment applies here. Another point here:
;; using 0 for the default hashing functions sounds like a very bad idea
;; -- something that people will run into in the form of extremely bad
;; performance. In this case the docs do mention this -- but why not
;; use the default hash functions that racket already provides? Also,
;; the docs indicate that the degenerate hash function makes it
;; equivalent to a list-based dictionary, which is wrong: relying on
;; this seems bad (in case custom hashes are (or will be) more
;; sophisticated), and also it's equivalent to a list-based dictionary,
;; except with a costly constant factor for the hash machinery, and
;; without the advantages of an alist (order). In short, the docs
;; should really say "don't use this without hash functions" -- or
;; better, use the better hash functions as a default *or* don't make
;; them optional (at least the first one).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Ref Wrappers
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Eli: Ugh. So the above constructors are keyworded versions of hash
;; constructors in various forms, and here we take a *single* function
;; from the dict interface and split it into multiple functions? Is
;; there any point for this? If I were told just this high-level
;; description, I'd assume that an obvious motivation for doing this
;; would be performance, but in this case performance is lost. I also
;; lose the abolity to have a lazily computed default on the way, since
;; the default in `dict-ref/default' is a plain argument. The only new
;; thing here is the questionable `dict-ref/identity' (at least I have
;; never seen any code where something like that would be useful).
(define (dict-ref/check dict key)
(dict-ref dict key))
;; Eli: why the eta-expanded definition?
(define (dict-ref/identity dict key)
(dict-ref dict key (lambda () key)))
(define (dict-ref/default dict key default)
(dict-ref dict key (lambda () default)))
(define (dict-ref/failure dict key failure)
(dict-ref dict key (lambda () (failure))))
;; Eli: Um, why (lambda () (failure)) and not just `failure'??
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Union
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ((dict-duplicate-error name) key value1 value2) (define ((dict-duplicate-error name) key value1 value2)
(error name "duplicate values for key ~e: ~e and ~e" key value1 value2)) (error name "duplicate values for key ~e: ~e and ~e" key value1 value2))
@ -164,126 +46,8 @@
(combine/key k (dict-ref one k) v) (combine/key k (dict-ref one k) v)
v)))) v))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Property delegation
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Eli: Uh, what is this for? The documentation for this is unclear: it
;; has the technical details of what this is doing, but no explanation
;; about when this is useful. Specifically, it's unclear why I would
;; ever want a wrapped dictionary. (My best guess would be "something
;; that chaperons are a better solution for".)
(define (wrapped-dict-property
#:unwrap unwrap
#:wrap [wrap #f]
#:predicate [pred (lambda (x) #t)]
#:mutable? [mutable? #t]
#:functional? [functional? (if wrap #t #f)]
#:remove? [remove? #t])
(let* ([unwrap (protect-unwrap pred unwrap)]
[wrap (and wrap (protect-wrap pred wrap))])
(vector (wrapped-ref unwrap)
(and mutable? (wrapped-set! unwrap))
(and functional? wrap (wrapped-set unwrap wrap))
(and mutable? remove? (wrapped-remove! unwrap))
(and functional? remove? wrap (wrapped-remove unwrap wrap))
(wrapped-count unwrap)
(wrapped-iterate-first unwrap)
(wrapped-iterate-next unwrap)
(wrapped-iterate-key unwrap)
(wrapped-iterate-value unwrap))))
(define ((protect-unwrap pred unwrap) op x)
(unless (pred x)
(raise
(make-exn:fail:contract
(format "~a: expected a <~a>, but got: ~e"
op (object-name pred) x)
(current-continuation-marks))))
(unwrap x))
(define ((protect-wrap pred wrap) op x)
(let* ([y (wrap x)])
(unless (pred y)
(raise
(make-exn:fail:contract
(format "~a: tried to construct a <~a>, but got: ~e"
op (object-name pred) x)
(current-continuation-marks))))
y))
(define (wrapped-ref unwrap)
(case-lambda
[(dict key) (dict-ref (unwrap 'dict-ref dict) key)]
[(dict key fail) (dict-ref (unwrap 'dict-ref dict) key fail)]))
(define ((wrapped-set! unwrap) dict key value)
(dict-set! (unwrap 'dict-set! dict) key value))
(define ((wrapped-set unwrap wrap) dict key value)
(wrap 'dict-set (dict-set (unwrap 'dict-set dict) key value)))
(define ((wrapped-remove! unwrap) dict key)
(dict-remove! (unwrap 'dict-remove! dict) key))
(define ((wrapped-remove unwrap wrap) dict key)
(wrap 'dict-remove (dict-remove (unwrap 'dict-remove dict) key)))
(define ((wrapped-count unwrap) dict)
(dict-count (unwrap 'dict-count dict)))
(define ((wrapped-iterate-first unwrap) dict)
(dict-iterate-first (unwrap 'dict-iterate-first dict)))
(define ((wrapped-iterate-next unwrap) dict pos)
(dict-iterate-next (unwrap 'dict-iterate-next dict) pos))
(define ((wrapped-iterate-key unwrap) dict pos)
(dict-iterate-key (unwrap 'dict-iterate-key dict) pos))
(define ((wrapped-iterate-value unwrap) dict pos)
(dict-iterate-value (unwrap 'dict-iterate-value dict) pos))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Exports
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide dict/c)
(provide/contract (provide/contract
[dict-empty? (-> dict? boolean?)] [dict-empty? (-> dict? boolean?)]
[empty-dict
(->* []
[#:mutable? boolean? #:weak? boolean? #:compare (or/c 'eq 'eqv 'equal)]
hash?)]
[make-dict
(->* [dict?]
[#:mutable? boolean? #:weak? boolean? #:compare (or/c 'eq 'eqv 'equal)]
hash?)]
[custom-dict
(->* [(-> any/c any/c any/c)]
[(-> any/c exact-integer?) (-> any/c exact-integer?)
#:mutable? boolean? #:weak? boolean?]
dict?)]
[wrapped-dict-property
(->* [#:unwrap (-> dict? dict?)]
[#:wrap (-> dict? dict?)
#:predicate (-> any/c boolean?)
#:mutable? boolean?
#:remove? boolean?
#:functional? boolean?]
vector?)]
[dict-ref/identity (-> dict? any/c any/c)]
[dict-ref/default (-> dict? any/c any/c any/c)]
[dict-ref/failure (-> dict? any/c (-> any/c) any/c)]
[dict-ref/check
(->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?)] [dict-union (->* [(and/c dict? dict-can-functional-set?)]
[#:combine [#:combine
(-> any/c any/c any/c) (-> any/c any/c any/c)

11
collects/unstable/gui/language-level.rkt
View File

@ -1,8 +1,6 @@
#lang racket/gui #lang racket/gui
(require drracket/tool (require drracket/tool
string-constants string-constants
unstable/dict
(only-in test-engine/scheme-gui make-formatter) (only-in test-engine/scheme-gui make-formatter)
(only-in test-engine/scheme-tests (only-in test-engine/scheme-tests
scheme-test-data test-format test-execute) scheme-test-data test-format test-execute)
@ -87,11 +85,10 @@
(super-new) (super-new)
(define/augment (capability-value key) (define/augment (capability-value key)
(dict-ref/failure (dict-ref dict key
dict key (lambda ()
(lambda () (inner (drracket:language:get-capability-default key)
(inner (drracket:language:get-capability-default key) capability-value key))))))
capability-value key))))))
(define language-level-no-executable-mixin (define language-level-no-executable-mixin
(mixin (drracket:language:language<%>) () (mixin (drracket:language:language<%>) ()

92
collects/unstable/gui/window.rkt
View File

@ -1,92 +0,0 @@
#lang racket/gui
(provide
locked-text-field-mixin
locked-text-field%
locked-combo-field%
union-container-mixin
union-pane%
union-panel%)
;; ======================================================================
;;
;; LOCKED TEXT FIELD CLASS / MIXIN
;;
;; ======================================================================
(define locked-text-field-mixin
(mixin [(class->interface text-field%)] []
(inherit get-editor)
(define/override (set-value str)
(send (get-editor) lock #f)
(super set-value str)
(send (get-editor) lock #t))
(super-new)
(init [undo-history 0])
(send (get-editor) lock #t)
(send (get-editor) set-max-undo-history undo-history)))
(define locked-text-field%
(locked-text-field-mixin text-field%))
(define locked-combo-field%
(locked-text-field-mixin combo-field%))
;; ======================================================================
;;
;; UNION PANEL CLASS / MIXIN
;;
;; ======================================================================
(define union-container-mixin
(mixin [area-container<%>] []
(super-new)
(inherit get-children get-alignment)
(define/public (choose child)
(for ([child* (get-children)])
(send child* show (eq? child* child))))
(define/override (container-size info)
(match info
[(list (list w h _ _) ...)
(values (apply max 0 w)
(apply max 0 h))]))
(define/override (place-children info w0 h0)
(let*-values ([(ha va) (get-alignment)]
[(hp) (horiz->place ha)]
[(vp) (vert->place va)])
(map (lambda (child) (place-child hp vp w0 h0 child)) info)))
(define/private (place-child hp vp w0 h0 child)
(match child
[(list cw ch sw sh)
(let*-values ([(x w) (place-dim hp w0 cw sw)]
[(y h) (place-dim vp h0 ch sh)])
(list x y w h))]))
(define/private (place-dim p maximum minimum stretch?)
(match (list p stretch?)
[(list _ #t) (values 0 maximum)]
[(list 'min #f) (values 0 minimum)]
[(list 'mid #f) (values (floor (/ (- maximum minimum) 2)) minimum)]
[(list 'max #f) (values (- maximum minimum) minimum)]))
(define/private horiz->place
(match-lambda ['left 'min] ['center 'mid] ['right 'max]))
(define/private vert->place
(match-lambda ['top 'min] ['center 'mid] ['bottom 'max]))))
(define union-pane% (union-container-mixin pane%))
(define union-panel% (union-container-mixin panel%))

5
collects/unstable/list.rkt
View File

@ -139,7 +139,10 @@
(define (map/values n f . ls) (define (map/values n f . ls)
(apply values (map/list n f ls))) (apply values (map/list n f ls)))
(provide map/values) (define (map2 f . ls)
(apply values (map/list 2 f ls)))
(provide map2 map/values)
;; dvanhorn added: ;; dvanhorn added:

19
collects/unstable/port.rkt
View File

@ -3,24 +3,6 @@
racket/contract racket/contract
syntax/srcloc) syntax/srcloc)
#|
Ryan:
Shouldn't this be called read-bytes/avail instead? (parallel existing names)
Changed to eliminate thread-unsafe buffer.
|#
(define (read-available-bytes [port (current-input-port)])
(read-available-bytes/offset port (make-bytes 1024) 0))
(define (read-available-bytes/offset port buffer offset)
(let* ([result (read-bytes-avail!* buffer port offset)])
(if (eof-object? result)
(if (zero? offset) result (subbytes buffer 0 offset))
(let ([new-offset (+ offset result)])
(if (= new-offset (bytes-length buffer))
(let ([new-buffer (bytes-append buffer buffer)])
(read-available-bytes/offset port new-buffer new-offset))
(subbytes buffer 0 new-offset))))))
(define (port->srcloc port [source (object-name port)] [span 0]) (define (port->srcloc port [source (object-name port)] [span 0])
(let*-values ([(line col pos) (port-next-location port)]) (let*-values ([(line col pos) (port-next-location port)])
(make-srcloc source line col pos span))) (make-srcloc source line col pos span)))
@ -52,5 +34,4 @@ Ryan:
[read-all-syntax [read-all-syntax
(->* [] [(-> (or/c syntax? eof-object?)) input-port?] (->* [] [(-> (or/c syntax? eof-object?)) input-port?]
(syntax/c list?))] (syntax/c list?))]
[read-available-bytes (->* [] [input-port?] (or/c bytes? eof-object?))]
[port->srcloc (->* [port?] [any/c exact-nonnegative-integer?] srcloc?)]) [port->srcloc (->* [port?] [any/c exact-nonnegative-integer?] srcloc?)])

62
collects/unstable/regexp.rkt
View File

@ -1,62 +0,0 @@
#lang racket/base
(require racket/list racket/contract)
;; Ryan: These functions should also allow regexp objects, use object-name to get strings.
;; And use string-join instead of add-between.
;; regexp-or : String ... -> String
;; Produces the regexp disjunction of several regexp-strings.
(define (regexp-or . strings)
(apply string-append (add-between strings "|")))
;; regexp-maybe : String ... -> String
;; Matches the sequence of regexps, or nothing.
(define (regexp-maybe . strings)
(format "(?:~a)?" (apply regexp-sequence strings)))
;; regexp-star : String ... -> String
;; Matches zero or more occurrences of the sequence of regexps.
(define (regexp-star . strings)
(format "(?:~a)*" (apply regexp-sequence strings)))
;; regexp-plus : String ... -> String
;; Matches one or more occurrences of the sequence of regexps.
(define (regexp-plus . strings)
(format "(?:~a)+" (apply regexp-sequence strings)))
;; regexp-save : String ... -> String
;; Matches and records the matched text of the sequence of regexps.
(define (regexp-save . strings)
(format "(~a)" (apply regexp-sequence strings)))
(define (regexp-group string)
(format "(?:~a)" string))
;; regexp-sequence
;; : String ... [#:start String #:end String #:between String] -> String
(define (regexp-sequence #:start [start ""]
#:end [end ""]
#:between [between ""]
. strings)
(apply string-append
(append (list start)
(add-between (map regexp-group strings) between)
(list end))))
;; regexp-multi : String ... -> String
;; Match a sequence of regexps in multi-line mode.
(define (regexp-multi . strings)
(format "(?m:~a)" (apply regexp-sequence strings)))
(provide/contract
[regexp-sequence
(->* [] [#:start string? #:end string? #:between string?]
#:rest (listof string?)
string?)]
[regexp-or (->* [string?] [] #:rest (listof string?) string?)]
[regexp-maybe (->* [string?] [] #:rest (listof string?) string?)]
[regexp-star (->* [string?] [] #:rest (listof string?) string?)]
[regexp-plus (->* [string?] [] #:rest (listof string?) string?)]
[regexp-save (->* [string?] [] #:rest (listof string?) string?)]
[regexp-multi (->* [string?] [] #:rest (listof string?) string?)])

131
collects/unstable/require.rkt
View File

@ -1,80 +1,10 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base (require (for-syntax racket/base
racket/match
racket/require-transform racket/require-transform
racket/provide-transform racket/provide-transform
syntax/parse syntax/parse))
planet/syntax) (provide require/provide
planet/version quote-require)
unstable/define)
(define-syntax (define-planet-package stx)
(syntax-parse stx
[(_ name:id pkg:id)
(syntax/loc stx
(define-syntax name
(make-require-transformer
(lambda (stx*)
(syntax-parse stx*
[(_) (expand-import (datum->syntax stx* (list #'planet #'pkg)))]
[(_ file:id)
(let* ([prefix (symbol->string (syntax-e #'pkg))]
[suffix (symbol->string (syntax-e #'file))]
[sym (string->symbol (string-append prefix "/" suffix))]
[spec (datum->syntax stx* (list #'planet sym))])
(expand-import spec))])))))]))
(define-syntax (define-collection stx)
(syntax-parse stx
[(_ name:id collect:id)
#'(define-syntax name
(make-require-transformer
(lambda (stx*)
(syntax-parse stx*
[(_) (expand-import (datum->syntax stx* (syntax-e #'collect)))]
[(_ file:id)
(let* ([prefix (symbol->string (syntax-e #'collect))]
[suffix (symbol->string (syntax-e #'file))]
[sym (string->symbol (string-append prefix "/" suffix))]
[spec (datum->syntax stx* sym)])
(expand-import spec))]))))]))
(define-syntax this-package-out
(make-provide-transformer
(lambda (stx modes)
(syntax-parse stx
[(_ file:id)
(expand-export
(datum->syntax
stx
(list #'all-from-out (make-planet-require-spec stx #'file)))
modes)]))))
(define-for-syntax (import->export i)
(make-export (import-local-id i)
(syntax-e (import-local-id i))
(import-mode i)
#f
(import-orig-stx i)))
(define-syntax box-require
(make-require-transformer
(lambda (stx)
(syntax-parse stx
[(_ ibox spec:expr)
#:declare ibox (static box? "mutable box for expanded import specs")
(let-values ([(imports sources) (expand-import #'spec)])
(set-box! (syntax-local-value #'ibox) imports)
(values imports sources))]))))
(define-syntax box-provide
(make-provide-transformer
(lambda (stx modes)
(syntax-parse stx
[(_ ibox)
#:declare ibox (static box? "mutable box for expanded import specs")
(map import->export (unbox (syntax-local-value #'ibox)))]))))
(define-syntax-rule (require/provide spec ...) (define-syntax-rule (require/provide spec ...)
(begin (begin
@ -90,38 +20,27 @@
(with-syntax ([(name ...) (map import-local-id imports)]) (with-syntax ([(name ...) (map import-local-id imports)])
(syntax/loc stx '(name ...))))])) (syntax/loc stx '(name ...))))]))
;; rename-import : Import Identifier -> Import (define-syntax box-require
;; Creates a new import that binds the given identifier, but otherwise acts as (make-require-transformer
;; the original import. (lambda (stx)
(define-for-syntax (rename-import i id) (syntax-parse stx
(struct-copy import i [local-id id])) [(_ ibox spec:expr)
#:declare ibox (static box? "mutable box for expanded import specs")
(let-values ([(imports sources) (expand-import #'spec)])
(set-box! (syntax-local-value #'ibox) imports)
(values imports sources))]))))
;; import->raw-require-spec : Import -> Syntax (define-for-syntax (import->export i)
;; Constructs a raw-require-spec (suitable for #%require) that should have the (make-export (import-local-id i)
;; same behavior as a require-spec that produces the given import. (syntax-e (import-local-id i))
(define-for-syntax (import->raw-require-spec i) (import-mode i)
(match i #f
[(struct import [local-id (import-orig-stx i)))
src-sym
src-mod-path
mode
req-mode
orig-mode
orig-stx])
(datum->syntax
orig-stx
(list #'just-meta
req-mode
(list #'for-meta
mode
(list #'rename
src-mod-path
(syntax-local-introduce local-id)
src-sym)))
orig-stx)]))
(provide require/provide (define-syntax box-provide
quote-require (make-provide-transformer
define-planet-package (lambda (stx modes)
define-collection (syntax-parse stx
this-package-in) [(_ ibox)
#:declare ibox (static box? "mutable box for expanded import specs")
(map import->export (unbox (syntax-local-value #'ibox)))]))))

57
collects/unstable/sandbox.rkt
View File

@ -1,57 +0,0 @@
#lang racket/base
(require racket/promise
racket/sandbox)
(provide make-trusted-evaluator
make-trusted-module-evaluator
make-scribble-evaluator
make-scribble-module-evaluator
make-sandbox-namespace-specs)
(define make-trusted-evaluator
(make-keyword-procedure
(lambda (keys vals . args)
(call-with-trusted-sandbox-configuration
(lambda ()
(keyword-apply make-evaluator keys vals args))))))
(define make-trusted-module-evaluator
(make-keyword-procedure
(lambda (keys vals . args)
(call-with-trusted-sandbox-configuration
(lambda ()
(keyword-apply make-module-evaluator keys vals args))))))
(define make-scribble-evaluator
(make-keyword-procedure
(lambda (keys vals . args)
(parameterize ([sandbox-output 'string]
[sandbox-error-output 'string])
(keyword-apply make-trusted-evaluator keys vals args)))))
(define make-scribble-module-evaluator
(make-keyword-procedure
(lambda (keys vals . args)
(parameterize ([sandbox-output 'string]
[sandbox-error-output 'string])
(keyword-apply make-trusted-module-evaluator keys vals args)))))
(define (make-sandbox-namespace-specs make-ns . paths)
(define parent
(delay
(let* ([ns (make-ns)])
(parameterize ([current-namespace ns])
(for ([path (in-list paths)])
(dynamic-require path #f)))
ns)))
(define (make-child)
(let* ([ns (make-ns)])
(parameterize ([current-namespace ns])
(for ([path (in-list paths)])
(namespace-attach-module (force parent) path)))
ns))
(list make-child))

88
collects/unstable/scribblings/class.scrbl
View File

@ -1,88 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/class))
@title{Classes and Objects}
@defmodule[unstable/class]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides tools for classes, objects, and mixins.
@section{Predicates and Contracts}
@defthing[class-or-interface/c flat-contract?]{
Recognizes classes and interfaces.
}
@defproc[(object-provides/c [spec class-or-interface/c] ...) flat-contract?]{
Recognizes objects which are instances of all the given classes and interfaces.
}
@defproc[(class-provides/c [spec class-or-interface/c] ...) flat-contract?]{
Recognizes classes which are subclasses (not strictly) and implementations,
respectively, of all the given classes and interfaces.
}
@defform[(mixin-provides/c [super-expr ...] [sub-expr ...])]{
Function contract for a mixin whose argument is the parent class @var[c%]
matching @scheme[(class-provides/c super-expr ...)] and whose result matches
@scheme[(class-provides/c #,(var c%) sub-expr ...)].
}
@section{Mixins}
@defproc[(ensure-interface [i<%> interface?]
[mx (mixin-provides/c [] [i<%>])]
[c% class?])
(class-provides/c c% i<%>)]{
Returns @scheme[c%] if it implements @scheme[i<%>]; otherwise, returns
@scheme[(mx c%)].
}
@section{Methods}
@defform[(send+ obj [message arg ...] ...)]{
Sends each message (with arguments) to @scheme[obj], then returns @scheme[obj].
@defexamples[
#:eval (eval/require 'racket/class 'unstable/class)
(define c%
(class object%
(super-new)
(define/public (say msg) (printf "~a!\n" msg))))
(send+ (new c%) [say 'Hello] [say 'Good-bye])
]
}
@defform[(send-each objs message arg ...)]{
Sends the message to each object in the list @scheme[objs], returning
@scheme[(void)].
@defexamples[
#:eval (eval/require 'racket/class 'unstable/class)
(define c%
(class object%
(super-new)
(init-field msg)
(define/public (say to) (printf "~a, ~a!\n" msg to))))
(send-each
(list (new c% [msg 'Hello])
(new c% [msg 'Good-bye]))
say 'World)
]
}

160
collects/unstable/scribblings/dict.scrbl
View File

@ -9,127 +9,6 @@
This module provides tools for manipulating dictionary values. This module provides tools for manipulating dictionary values.
@section{Dictionary Constructors}
@defproc[(empty-dict [#:mutable? mutable? boolean? weak?]
[#:weak? weak? boolean? #f]
[#:compare compare (or/c 'eq 'eqv 'equal) equal])
hash?]{
Constructs an empty hash table based on the behavior specified by
@scheme[mutable?], @scheme[weak?], and @scheme[compare].
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(empty-dict)
(empty-dict #:mutable? #t)
(empty-dict #:weak? #t)
(empty-dict #:compare 'eqv)
]
}
@defproc[(make-dict [d dict?]
[#:mutable? mutable? boolean? weak?]
[#:weak? weak? boolean? #f]
[#:compare compare (or/c 'eq 'eqv 'equal) equal])
hash?]{
Converts a given dictionary @scheme[d] to a hash table based on the behavior
specified by @scheme[mutable?], @scheme[weak?], and @scheme[compare].
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(make-dict '([1 . one] [2 . two]))
(make-dict '([1 . one] [2 . two]) #:mutable? #t)
(make-dict '([1 . one] [2 . two]) #:weak? #t)
(make-dict '([1 . one] [2 . two]) #:compare 'eqv)
]
}
@defproc[(custom-dict [equiv? (-> any/c any/c any/c)]
[hash-primary (-> any/c exact-integer?) (lambda (x) 0)]
[hash-secondary (-> any/c exact-integer?) (lambda (x) 0)]
[#:mutable? mutable? boolean? weak?]
[#:weak? weak? boolean? #f])
dict?]{
Constructs a dictionary based on custom comparison and optional hash functions.
Given no hash functions, the dictionary defaults to a degenerate hash function
and is thus essentially equivalent to a list-based dictionary.
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(define table (custom-dict = add1 sub1 #:mutable? #t))
(dict-set! table 1 'one)
(dict-set! table 2 'two)
(for/list ([(key val) (in-dict table)])
(cons key val))
]
}
@section{Dictionary Lookup}
@defproc[(dict-ref/check [d dict?] [k (lambda (k) (dict-has-key? d k))])
any/c]{
Looks up key @scheme[k] in dictionary @scheme[d]. Raises a contract error if
@scheme[d] has no entry for @scheme[k]. Equivalent to @scheme[(dict-ref d k)],
except for the specific exception value raised.
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/check '([1 . one] [2 . two] [3 . three]) 2)
]
}
@defproc[(dict-ref/identity [d dict?] [k any/c]) any/c]{
Looks up key @scheme[k] in dictionary @scheme[d]. Returns @scheme[k] if
@scheme[d] has no entry for @scheme[k]. Equivalent to
@scheme[(dict-ref d k (lambda () k))].
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/identity '([1 . one] [2 . two] [3 . three]) 2)
(dict-ref/identity '([1 . one] [2 . two] [3 . three]) 4)
]
}
@defproc[(dict-ref/default [d dict?] [k any/c] [v any/c]) any/c]{
Looks up key @scheme[k] in dictionary @scheme[d]. Returns @scheme[v] if
@scheme[d] has no entry for @scheme[k]. Equivalent to
@scheme[(dict-ref d k (lambda () v))].
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/default '([1 . one] [2 . two] [3 . three]) 2 'other)
(dict-ref/default '([1 . one] [2 . two] [3 . three]) 4 'other)
]
}
@defproc[(dict-ref/failure [d dict?] [k any/c] [f (-> any/c)]) any/c]{
Looks up key @scheme[k] in dictionary @scheme[d]. Returns the result of
applying @scheme[f] (in tail position) if @scheme[d] has no entry for
@scheme[k]. Equivalent to @scheme[(dict-ref d k f)].
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/failure '([1 . one] [2 . two] [3 . three]) 2 gensym)
(dict-ref/failure '([1 . one] [2 . two] [3 . three]) 4 gensym)
]
}
@section{Dictionary Accessors}
@defproc[(dict-empty? [d dict?]) boolean?]{ @defproc[(dict-empty? [d dict?]) boolean?]{
Reports whether @scheme[d] is empty (has no keys). Reports whether @scheme[d] is empty (has no keys).
@ -142,8 +21,6 @@ Reports whether @scheme[d] is empty (has no keys).
} }
@section{Dictionary Combinations}
@defproc[(dict-union [d0 (and/c dict? dict-can-functional-set?)] @defproc[(dict-union [d0 (and/c dict? dict-can-functional-set?)]
[d dict?] ... [d dict?] ...
[#:combine combine [#:combine combine
@ -199,40 +76,3 @@ d
] ]
} }
@section{Dictionary Structure Properties}
@defproc[(wrapped-dict-property
[#:unwrap unwrap (-> (and/c dict? pred) dict?)]
[#:wrap wrap (-> dict? (and/c dict? pred)) (lambda (x) x)]
[#:predicate pred (-> any/c boolean?) (lambda (x) #t)]
[#:mutable? mutable? boolean? weak?]
[#:weak? mutable? boolean? #f]
[#:functional? functional? boolean? #t])
vector?]{
Produces a value appropriate for @scheme[prop:dict] for a derived dictionary
type recognized by @scheme[pred]. Dictionaries constructed from this property
will extract a nested dictionary using @scheme[unwrap] and will produce a
wrapped dictionary during functional update using @scheme[wrap].
@defexamples[
#:eval (eval/require 'racket/dict 'unstable/dict)
(define-struct table [dict]
#:transparent
#:property prop:dict
(wrapped-dict-property
#:unwrap (lambda (d) (table-dict d))
#:wrap (lambda (d) (make-table d))
#:predicate (lambda (d) (table? d))))
(dict? (make-table '([1 . one] [2 . two])))
(dict-ref (make-table '([1 . one] [2 . two])) 1)
(dict-set (make-table '([1 . one] [2 . two])) 3 'three)
]
}
@section{Contracted Dictionaries}
This library re-provides @scheme[dict/c] from
@schememodname[unstable/contract].

1
collects/unstable/scribblings/gui.scrbl
View File

@ -11,4 +11,3 @@
@include-section["gui/notify.scrbl"] @include-section["gui/notify.scrbl"]
@include-section["gui/prefs.scrbl"] @include-section["gui/prefs.scrbl"]
@include-section["gui/slideshow.scrbl"] @include-section["gui/slideshow.scrbl"]
@include-section["gui/window.scrbl"]

27
collects/unstable/scribblings/gui/language-level.scrbl
View File

@ -2,7 +2,6 @@
@(require "../utils.rkt" @(require "../utils.rkt"
(for-label racket/gui (for-label racket/gui
drracket/tool-lib drracket/tool-lib
unstable/class
unstable/gui/language-level)) unstable/gui/language-level))
@title{DrRacket Language Levels} @title{DrRacket Language Levels}
@ -30,7 +29,7 @@ This unit imports @scheme[drracket:tool^] and exports @scheme[language-level^].
[#:reader reader [#:reader reader
(->* [] [any/c input-port?] (or/c syntax? eof-object?)) (->* [] [any/c input-port?] (or/c syntax? eof-object?))
read-syntax]) read-syntax])
(object-provides/c drracket:language:language<%>)]{ (is-a?/c drracket:language:language<%>)]{
Constructs a language level as an instance of Constructs a language level as an instance of
@scheme[drracket:language:language<%>] with the given @scheme[name] based on the @scheme[drracket:language:language<%>] with the given @scheme[name] based on the
@ -43,9 +42,9 @@ reader.
} }
@defthing[simple-language-level% @defthing[simple-language-level%
(class-provides/c drracket:language:language<%> (and/c (implementation?/c drracket:language:language<%>)
drracket:language:module-based-language<%> (implementation?/c drracket:language:module-based-language<%>)
drracket:language:simple-module-based-language<%>)]{ (implementation?/c drracket:language:simple-module-based-language<%>))]{
Equal to Equal to
@scheme[ @scheme[
@ -57,7 +56,7 @@ Equal to
@defproc[(language-level-render-mixin [to-sexp (-> any/c any/c)] @defproc[(language-level-render-mixin [to-sexp (-> any/c any/c)]
[show-void? boolean?]) [show-void? boolean?])
(mixin-provides/c [drracket:language:language<%>] [])]{ (make-mixin-contract drracket:language:language<%>)]{
Produces a mixin that overrides @method[drracket:language:language<%> Produces a mixin that overrides @method[drracket:language:language<%>
render-value/format] to apply @scheme[to-sexp] to each value before printing it, render-value/format] to apply @scheme[to-sexp] to each value before printing it,
@ -67,7 +66,7 @@ and to skip @scheme[void?] values (pre-transformation) if @scheme[show-void?] is
} }
@defproc[(language-level-capability-mixin [dict dict?]) @defproc[(language-level-capability-mixin [dict dict?])
(mixin-provides/c [drracket:language:language<%>] [])]{ (make-mixin-contract drracket:language:language<%>)]{
Produces a mixin that augments @method[drracket:language:language<%> Produces a mixin that augments @method[drracket:language:language<%>
capability-value] to look up each key in @scheme[dict], producing the capability-value] to look up each key in @scheme[dict], producing the
@ -77,7 +76,7 @@ otherwise.
} }
@defthing[language-level-no-executable-mixin @defthing[language-level-no-executable-mixin
(mixin-provides/c [drracket:language:language<%>] [])]{ (make-mixin-contract drracket:language:language<%>)]{
Overrides @method[drracket:language:language<%> create-executable] to print an Overrides @method[drracket:language:language<%> create-executable] to print an
error message in a dialog box. error message in a dialog box.
@ -85,9 +84,8 @@ error message in a dialog box.
} }
@defthing[language-level-eval-as-module-mixin @defthing[language-level-eval-as-module-mixin
(mixin-provides/c [drracket:language:language<%> (make-mixin-contract drracket:language:language<%>
drracket:language:module-based-language<%>] drracket:language:module-based-language<%>)]{
[])]{
Overrides @method[drracket:language:language<%> front-end/complete-program] to Overrides @method[drracket:language:language<%> front-end/complete-program] to
wrap terms from the definition in a module based on the language level's wrap terms from the definition in a module based on the language level's
@ -97,15 +95,14 @@ for instance.
} }
@defthing[language-level-macro-stepper-mixin @defthing[language-level-macro-stepper-mixin
(mixin-provides/c [drracket:language:language<%>] (make-mixin-contract drracket:language:language<%>)]{
[])]{
This mixin enables the macro stepper for its language level. This mixin enables the macro stepper for its language level.
} }
@defthing[language-level-check-expect-mixin @defthing[language-level-check-expect-mixin
(mixin-provides/c [drracket:language:language<%>] [])]{ (make-mixin-contract drracket:language:language<%>)]{
This mixin overrides @method[drracket:language:language<%> on-execute] to set up This mixin overrides @method[drracket:language:language<%> on-execute] to set up
the @scheme[check-expect] test engine to a language level similarly to the HtDP the @scheme[check-expect] test engine to a language level similarly to the HtDP
@ -118,7 +115,7 @@ teaching languages.
[meta-lines exact-nonnegative-integer?] [meta-lines exact-nonnegative-integer?]
[meta->settings (-> string? any/c any/c)] [meta->settings (-> string? any/c any/c)]
[settings->meta (-> symbol? any/c string?)]) [settings->meta (-> symbol? any/c string?)])
(mixin-provides/c [drracket:language:language<%>] [])]{ (make-mixin-contract drracket:language:language<%>)]{
This mixin constructs a language level that stores metadata in saved files This mixin constructs a language level that stores metadata in saved files
allowing Drracket to automatically switch back to this language level upon allowing Drracket to automatically switch back to this language level upon

80
collects/unstable/scribblings/gui/window.scrbl
View File

@ -1,80 +0,0 @@
#lang scribble/manual
@(require "../utils.rkt" (for-label racket/gui unstable/gui/window))
@title{GUI Widgets}
@defmodule[unstable/gui/window]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
@section{Locked Text Fields}
These classes and mixins provide text and combo field controls that cannot be
directly edited by the user, but may be updated by other controls.
@defmixin[locked-text-field-mixin (text-field%) ()]{
This mixin updates text field classes to prevent user edits, but allow
programmatic update of the text value. It also sets the undo history length to
a default of 0, as user undo commands are disabled and the history takes up
space.
@defconstructor[([undo-history exact-nonnegative-integer? 0])]{
The mixin adds the @scheme[undo-history] initialization argument to control the
length of the undo history. It defaults to 0 to save space, but may be set
higher.
The mixin inherits all the initialization arguments of its parent class; it does
not override any of them.
}
@defmethod[#:mode override (set-value [str string?]) void?]{
Unlocks the text field's nested editor, calls the parent class's
@method[text-field% set-value], and then re-locks the editor.
}
}
@defclass[locked-text-field% text-field% ()]{
Equal to @scheme[(locked-text-field-mixin text-field%)].
}
@defclass[locked-combo-field% combo-field% ()]{
Equal to @scheme[(locked-text-field-mixin combo-field%)].
}
@section{Union GUIs}
@defmixin[union-container-mixin (area-container<%>) ()]{
This mixin modifies a container class to display only one of its child areas at
a time, but to leave room to switch to any of them.
@defmethod[(choose [child (is-a?/c subwindow<%>)]) void?]{
This method changes which of the container's children is displayed. The chosen
child is shown and the previous choice is hidden.
}
}
@defclass[union-pane% pane% ()]{
Equal to @scheme[(union-container-mixin pane%)].
}
@defclass[union-panel% panel% ()]{
Equal to @scheme[(union-container-mixin panel%)].
}

13
collects/unstable/scribblings/list.scrbl
View File

@ -103,6 +103,19 @@ Produces lists of the respective values of @racket[f] applied to the elements in
} }
@defproc[(map2 [f (-> A ... (values B C))] [lst (listof A)] ...)
(values (listof B) (listof C))]{
Produces a pair of lists of the respective values of @scheme[f] applied to the
elements in @scheme[lst ...] sequentially.
@defexamples[
#:eval (eval/require 'unstable/list)
(map2 (lambda (x) (values (+ x 1) (- x 1))) (list 1 2 3))
]
}
@addition{David Van Horn} @addition{David Van Horn}
@defproc[(remf [pred procedure?] @defproc[(remf [pred procedure?]

22
collects/unstable/scribblings/port.scrbl
View File

@ -68,25 +68,3 @@ counting must be enabled for @scheme[port] to get meaningful results.
] ]
} }
@defproc[(read-available-bytes [port input-port? (current-input-port)])
(or/c bytes? eof-object?)]{
This function reads all immediately available bytes from a port and produces a
byte string containing them. If there are no bytes available and the port is
known to have no more input, it produces @scheme[eof]; if there are none
available but the port may have more input, it produces an empty byte string.
This procedure never blocks to wait for input from the port.
@defexamples[
#:eval (eval/require 'unstable/port)
(define-values [in out] (make-pipe))
(parameterize ([current-input-port in]) (read-available-bytes))
(write-byte (char->integer #\c) out)
(read-available-bytes in)
(read-available-bytes in)
(close-output-port out)
(read-available-bytes in)
]
}

125
collects/unstable/scribblings/regexp.scrbl
View File

@ -1,125 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/regexp))
@title{Regular Expressions}
@defmodule[unstable/regexp]
This module provides tools for building strings which can be compiled to regular
expressions. In particular, the constructors wrap their arguments in
appropriate delimeters to prevent misparsing after concatenation.
@defproc[(regexp-sequence [#:start start string? ""]
[#:between between string? ""]
[#:end end string? ""]
[re string?] ...)
string?]{
Produces a regular expression string that matches @scheme[start], followed by
each @scheme[re] interleaved with @scheme[between], followed by @scheme[end].
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re
(pregexp
(regexp-sequence "[0-9]+" "[0-9]+" "[0-9]+"
#:start (regexp-quote "(")
#:between (regexp-quote ",")
#:end (regexp-quote ")"))))
(regexp-match-exact? re "(1,10,100)")
(regexp-match-exact? re "(1,10)")
(regexp-match-exact? re " ( 1 , 10 , 100 ) ")
]
}
@defproc[(regexp-or [re string?] ...+) string?]{
Produces a regular expression string that matches any of the given @scheme[re]s.
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re (pregexp (regexp-or "[0-9]+" "[a-z]")))
(regexp-match-exact? re "123")
(regexp-match-exact? re "c")
(regexp-match-exact? re "12c")
]
}
@defproc[(regexp-maybe [re string?] ...+) string?]{
Produces a regular expression string that matches either the empty string, or
the concatenation of all the given @scheme[re]s.
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re (pregexp (regexp-maybe "[0-9]+" "[.]" "[0-9]+")))
(regexp-match-exact? re "123.456")
(regexp-match-exact? re "")
(regexp-match-exact? re "123")
]
}
@defproc[(regexp-star [re string?] ...+) string?]{
Produces a regular expression string that matches zero or more consecutive
occurrences of the concatenation of the given @scheme[re]s.
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re (pregexp (regexp-star "a" "b" "c")))
(regexp-match-exact? re "")
(regexp-match-exact? re "abc")
(regexp-match-exact? re "abcabcabc")
(regexp-match-exact? re "a")
]
}
@defproc[(regexp-plus [re string?] ...+) string?]{
Produces a regular expression string that matches one or more consecutive
occurrences of the concatenation of the given @scheme[re]s.
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re (pregexp (regexp-plus "a" "b" "c")))
(regexp-match-exact? re "")
(regexp-match-exact? re "abc")
(regexp-match-exact? re "abcabcabc")
(regexp-match-exact? re "a")
]
}
@defproc[(regexp-save [re string?] ...+) string?]{
Produces a regular expression string that matches the concatenation of the given
@scheme[re]s and saves the result.
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re
(pregexp (regexp-sequence (regexp-save "[0-9]+") "\\1")))
(regexp-match-exact? re "11")
(regexp-match-exact? re "123123")
(regexp-match-exact? re "123456")
]
}
@defproc[(regexp-multi [re string?] ...+) string?]{
Produces a regular expression string that matches the concatenation of the given
@scheme[re]s in multiple-line mode.
@defexamples[
#:eval (eval/require 'unstable/regexp)
(define re (pregexp (regexp-multi "^abc$")))
(regexp-match? re "abc")
(regexp-match? re "xyz\nabc\ndef")
]
}

54
collects/unstable/scribblings/require.scrbl
View File

@ -28,57 +28,3 @@ Produces the names exported by the @scheme[require-spec]s as a list of symbols.
] ]
} }
@defform[(define-planet-package name package)]{
Defines a shortcut @scheme[name] for importing modules from planet package
@scheme[package]. Subsequently, @scheme[(name module)] is equivalent to
@scheme[(planet package/module)] as a require path. For instance, to import the
@scheme[text] and @scheme[web] modules from this package:
@schemeblock[
(define-planet-package my-package cce/scheme)
(require (my-package web) (my-package text))
]
The above @scheme[require] is equivalent to:
@schemeblock[
(require (planet cce/scheme/web) (planet cce/scheme/text))
]
}
@defform[(define-collection name collect)]{
Defines a shortcut @scheme[name] for importing modules from @scheme[collect] and
its subcollections. Subsequently, @scheme[(name)] is equivalent to
@scheme[collect] as a require path, and @scheme[(name path)] is equivalent to
@scheme[collect/path].
@schemeblock[
(define-collection macro syntax)
(require (macro parse))
]
The above @scheme[require] is equivalent to the below:
@schemeblock[
(require syntax/parse)
]
}
@defform[
(this-package-in path)
]{
This
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{require transformer}
imports the file at @scheme[path] in the current planet package. For instance,
in the package @schememodname[(planet cce/scheme:7)], writing:
@schemeblock[(require (this-package-in function))]
... is equivalent to writing:
@schemeblock[(require (planet cce/scheme:7/function))]
}

61
collects/unstable/scribblings/sandbox.scrbl
View File

@ -1,61 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt"
(for-label racket racket/sandbox unstable/sandbox))
@title{Sandboxed Evaluation}
@defmodule[unstable/sandbox]
This module provides tools for sandboxed evaluation.
@deftogether[(
@defproc[(make-trusted-evaluator
[language (or/c module-path?
(list/c 'special symbol?)
(cons/c 'begin list?))]
[input-program any/c] ...
[#:requires requires (listof (or/c module-path? path?))]
[#:allow-read allow (listof or/c module-path? path?)])
(any/c . -> . any)]
@defproc[(make-trusted-module-evaluator
[module-decl (or/c syntax? pair?)]
[#:language lang (or/c #f module-path?)]
[#:allow-read allow (listof (or/c module-path? path?))])
(any/c . -> . any)]
)]{
These procedures wrap calls to @scheme[make-evaluator] and
@scheme[make-module-evaluator], respectively, with
@scheme[call-with-trusted-sandbox-configuration].
}
@deftogether[(
@defproc[(make-scribble-evaluator
[language (or/c module-path?
(list/c 'special symbol?)
(cons/c 'begin list?))]
[input-program any/c] ...
[#:requires requires (listof (or/c module-path? path?))]
[#:allow-read allow (listof or/c module-path? path?)])
(any/c . -> . any)]
@defproc[(make-scribble-module-evaluator
[module-decl (or/c syntax? pair?)]
[#:language lang (or/c #f module-path?)]
[#:allow-read allow (listof (or/c module-path? path?))])
(any/c . -> . any)]
)]{
These procedures wrap calls to @scheme[make-trusted-evaluator] and
@scheme[make-trusted-module-evaluator], respectively, with parameterizations
setting @scheme[sandbox-output] and @scheme[sandbox-error-output] to
@scheme['string].
}
@defproc[(make-sandbox-namespace-specs [make-ns (-> namespace?)]
[path module-path?] ...)
(cons/c (-> namespace?) (listof module-path?))]{
This function produces a value for the parameter
@scheme[sandbox-namespace-specs] such that new sandbox evaluators start with a
namespace constructed by @scheme[make-ns] and share a set of instances of the
modules referred to by the given @scheme[path]s.
}

168
collects/unstable/scribblings/text.scrbl
View File

@ -1,168 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/text))
@title[#:tag "unstable-text"]{Text Representations}
@defmodule[unstable/text]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides tools for manipulating and converting textual data.
@section{Contracts and Predicates}
@deftogether[(
@defthing[text/c flat-contract?]{}
@defproc[(text? [v any/c]) boolean?]{}
)]{
This contract and predicate recognize text values: strings, byte strings,
symbols, and keywords, as well as syntax objects containing them.
@defexamples[
#:eval (eval/require 'unstable/text)
(text? "text")
(text? #"text")
(text? 'text)
(text? '#:text)
(text? #'"text")
(text? #'#"text")
(text? #'text)
(text? #'#:text)
(text? '(not text))
]
}
@deftogether[(
@defproc[(string-literal? [v any/c]) boolean?]{}
@defproc[(bytes-literal? [v any/c]) boolean?]{}
@defproc[(keyword-literal? [v any/c]) boolean?]{}
)]{
These predicates recognize specific text types stored in syntax objects.
@defexamples[
#:eval (eval/require 'unstable/text)
(string-literal? #'"literal")
(string-literal? "not literal")
(bytes-literal? #'#"literal")
(bytes-literal? #"not literal")
(keyword-literal? #'#:literal)
(keyword-literal? '#:not-literal)
]
}
@section{Text Conversions and Concatenation}
@deftogether[(
@defproc[(text->string [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[text text/c] ...) string?]{}
@defproc[(text->bytes [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[text text/c] ...) bytes?]{}
@defproc[(text->symbol [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[text text/c] ...) symbol?]{}
@defproc[(text->keyword [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[text text/c] ...) keyword?]{}
)]{
These functions convert text values to specific types. They concatenate each
@scheme[text] argument, adding @scheme[before] and @scheme[after] to the front
and back of the result and @scheme[between] between each argument.
@defexamples[
#:eval (eval/require 'unstable/text)
(text->string #"concat" #'enate)
(text->bytes #:between "-" 'concat #'#:enate)
(text->symbol #:before "(" #:after ")" '#:concat #'"enate")
(text->keyword #:before #'< #:between #'- #:after #'> "concat" #'#"enate")
]
}
@deftogether[(
@defproc[(text->string-literal [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[#:stx stx (or/c syntax? false/c) #f]
[text text/c] ...)
string-literal?]{}
@defproc[(text->bytes-literal [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[#:stx stx (or/c syntax? false/c) #f]
[text text/c] ...)
bytes-literal?]{}
@defproc[(text->identifier [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[#:stx stx (or/c syntax? false/c) #f]
[text text/c] ...)
identifier?]{}
@defproc[(text->keyword-literal [#:before before text/c ""]
[#:between between text/c ""]
[#:after after text/c ""]
[#:stx stx (or/c syntax? false/c) #f]
[text text/c] ...)
keyword-literal?]{}
)]{
These functions convert text values to specific syntax object types, deriving
syntax object properties from the @scheme[stx] argument. They concatenate each
@scheme[text] argument, adding @scheme[before] and @scheme[after] to the front
and back of the result and @scheme[between] between each argument.
@defexamples[
#:eval (eval/require 'unstable/text)
(text->string-literal #"concat" #'enate)
(text->bytes-literal #:between "-" 'concat #'#:enate)
(text->identifier #:before "(" #:after ")"
#:stx #'props
'#:concat #'"enate")
(text->keyword-literal #:before #'< #:between #'- #:after #'>
#:stx #'props
"concat" #'#"enate")
]
}
@section{Text Comparisons}
@deftogether[(
@defproc[(text=? [one text/c] [two text/c]) boolean?]
@defproc[(text<? [one text/c] [two text/c]) boolean?]
@defproc[(text<=? [one text/c] [two text/c]) boolean?]
@defproc[(text>? [one text/c] [two text/c]) boolean?]
@defproc[(text>=? [one text/c] [two text/c]) boolean?]
)]{
These predicates compare the character content of two text values. They are
equivalent to:
@schemeblock[
(text=? one two) = (string=? (text->string one) (text->string two))
(text<? one two) = (string<? (text->string one) (text->string two))
(text<=? one two) = (string<=? (text->string one) (text->string two))
(text>? one two) = (string>? (text->string one) (text->string two))
(text>=? one two) = (string>=? (text->string one) (text->string two))
]
@defexamples[
#:eval (eval/require 'unstable/text)
(text=? #"x" #'y)
(text<? #"x" #'y)
(text<=? #"x" #'y)
(text>? #"x" #'y)
(text>=? #"x" #'y)
]
}

28
collects/unstable/scribblings/unstable.scrbl
View File

@ -72,41 +72,35 @@ Keep documentation and tests up to date.
} }
@include-section["bytes.scrbl"] @include-section["bytes.scrbl"]
@include-section["class.scrbl"]
@include-section["contract.scrbl"] @include-section["contract.scrbl"]
@include-section["wrapc.scrbl"]
@include-section["prop-contract.scrbl"]
@include-section["debug.scrbl"]
@include-section["define.scrbl"] @include-section["define.scrbl"]
@include-section["dict.scrbl"] @include-section["dict.scrbl"]
@include-section["dirs.scrbl"] @include-section["dirs.scrbl"]
@include-section["exn.scrbl"] @include-section["exn.scrbl"]
@include-section["file.scrbl"] @include-section["file.scrbl"]
@include-section["find.scrbl"]
@include-section["mutated-vars.scrbl"] ;; Finding Mutable Variables
@include-section["function.scrbl"] @include-section["function.scrbl"]
@include-section["generics.scrbl"]
@include-section["hash.scrbl"]
@include-section["class-iop.scrbl"] ;; Interface-oriented Programming
@include-section["list.scrbl"] @include-section["list.scrbl"]
@include-section["markparam.scrbl"]
@include-section["match.scrbl"]
@include-section["net.scrbl"] @include-section["net.scrbl"]
@include-section["path.scrbl"] @include-section["path.scrbl"]
@include-section["port.scrbl"] @include-section["port.scrbl"]
@include-section["pretty.scrbl"] @include-section["pretty.scrbl"]
@include-section["regexp.scrbl"]
@include-section["require.scrbl"] @include-section["require.scrbl"]
@include-section["sandbox.scrbl"] @include-section["sequence.scrbl"]
@include-section["set.scrbl"] @include-section["set.scrbl"]
@include-section["sexp-diff.scrbl"] @include-section["sexp-diff.scrbl"]
@include-section["string.scrbl"] @include-section["string.scrbl"]
@include-section["struct.scrbl"] @include-section["struct.scrbl"]
@include-section["syntax.scrbl"] @include-section["syntax.scrbl"]
@include-section["text.scrbl"]
@include-section["values.scrbl"]
@include-section["web.scrbl"]
@include-section["mutated-vars.scrbl"]
@include-section["find.scrbl"]
@include-section["class-iop.scrbl"]
@include-section["sequence.scrbl"]
@include-section["hash.scrbl"]
@include-section["match.scrbl"]
@include-section["generics.scrbl"]
@include-section["markparam.scrbl"]
@include-section["debug.scrbl"]
@include-section["wrapc.scrbl"]
@include-section["prop-contract.scrbl"]
@;{--------} @;{--------}

84
collects/unstable/scribblings/values.scrbl
View File

@ -1,84 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/values))
@title{Multiple Values}
@defmodule[unstable/values]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides tools for manipulating functions and expressions that
produce multiple values.
@defform[(values->list expr)]{
Produces a list of the values returned by @scheme[expr].
@defexamples[
#:eval (eval/require 'unstable/values)
(values->list (values 1 2 3))
]
}
@defproc[(map2 [f (-> A ... (values B C))] [lst (listof A)] ...)
(values (listof B) (listof C))]{
Produces a pair of lists of the respective values of @scheme[f] applied to the
elements in @scheme[lst ...] sequentially.
@defexamples[
#:eval (eval/require 'unstable/values)
(map2 (lambda (x) (values (+ x 1) (- x 1))) (list 1 2 3))
]
}
@defproc[(map/values [n natural-number/c]
[f (-> A ... (values B_1 ... B_n))]
[lst (listof A)]
...)
(values (listof B_1) ... (listof B_n))]{
Produces lists of the respective values of @scheme[f] applied to the elements in
@scheme[lst ...] sequentially.
@defexamples[
#:eval (eval/require 'unstable/values)
(map/values
3
(lambda (x)
(values (+ x 1) x (- x 1)))
(list 1 2 3))
]
}
@deftogether[(
@defproc[(foldr/values [f (-> A ... B ... (values B ...))]
[vs (list/c B ...)]
[lst (listof A)]
...)
(values B ...)]
@defproc[(foldl/values [f (-> A ... B ... (values B ...))]
[vs (list/c B ...)]
[lst (listof A)]
...)
(values B ...)]
)]{
These functions combine the values in the lists @scheme[lst ...] using the
multiple-valued function @scheme[f]; @scheme[foldr/values] traverses the lists
right to left and @scheme[foldl/values] traverses left to right.
@defexamples[
#:eval (eval/require 'unstable/values)
(define (add/cons a b c d)
(values (+ a c) (cons b d)))
(foldr/values add/cons (list 0 null)
(list 1 2 3 4) (list 5 6 7 8))
(foldl/values add/cons (list 0 null)
(list 1 2 3 4) (list 5 6 7 8))
]
}

52
collects/unstable/scribblings/web.scrbl
View File

@ -1,52 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket xml unstable/web))
@title{XML and CSS}
@defmodule[unstable/web]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides tools for programmatic creation of static web pages. It is
based on the XML collection; see documentation for @scheme[xexpr?].
@deftogether[(
@defthing[css/c flat-contract?]
@defproc[(css? [v any/c]) boolean?]
)]{
This contract and predicate pair recognizes CSS-expressions, which are
described by the following grammar:
@schemegrammar*[
#:literals (cons list)
[css (list style ...)]
[style-def (cons selector (list property ...))]
[property (list name value)]
[selector text]
[name text]
[value text]
]
Here, @scheme[text] is any of the datatypes described in
@secref["unstable-text"].
}
@defthing[xexpr/c flat-contract?]{
This flat contract corresponds to @scheme[xexpr?]. It is reprovided from
@schememodname[xml]. In versions of Racket before the implementation of
@scheme[xexpr/c], this module provides its own definition.
}
@defproc[(write-css [css css/c] [out output-port? (current-output-port)])
void?]{
This function writes CSS-expressions to output ports by its
canonical text representation.
}
@deftogether[(
@defproc[(create-stylesheet [file path-string?] [css css/c]) void?]
@defproc[(create-webpage [file path-string?] [xexpr xexpr/c]) void?]
)]{
These functions write style sheets (represented as CSS-expressions) or
webpages (represented as X-expressions) to files.
}

129
collects/unstable/text.rkt
View File

@ -1,129 +0,0 @@
#lang racket/base
(require racket/list racket/match racket/contract)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; TEXT DATATYPE
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (literal? pred? v)
(and (syntax? v) (pred? (syntax-e v))))
(define (string-literal? v) (literal? string? v))
(define (bytes-literal? v) (literal? bytes? v))
(define (keyword-literal? v) (literal? keyword? v))
(define (text? v)
(or (symbol? v)
(string? v)
(keyword? v)
(bytes? v)
(and (syntax? v) (text? (syntax-e v)))))
(define (text=? a b)
(string=? (to-string a) (to-string b)))
(define (text>? a b)
(string>? (to-string a) (to-string b)))
(define (text>=? a b)
(string>=? (to-string a) (to-string b)))
(define (text<? a b)
(string<? (to-string a) (to-string b)))
(define (text<=? a b)
(string<=? (to-string a) (to-string b)))
(define (to-string t)
(cond
[(string? t) t]
[(symbol? t) (symbol->string t)]
[(keyword? t) (keyword->string t)]
[(bytes? t) (bytes->string/utf-8 t)]
[(syntax? t) (to-string (syntax-e t))]))
(define (combine-strings before between after strs)
(apply
string-append
before
(let loop ([strs strs])
(match strs
[(list) (list after)]
[(list str) (list str after)]
[(cons str strs) (list* str between (loop strs))]))))
(define ((to-text convert)
#:before [before ""]
#:between [between ""]
#:after [after ""]
. ts)
(convert (combine-strings (to-string before)
(to-string between)
(to-string after)
(map to-string ts))))
(define text->string (to-text values))
(define text->symbol (to-text string->symbol))
(define text->keyword (to-text string->keyword))
(define text->bytes (to-text string->bytes/utf-8))
(define ((to-literal convert)
#:stx [stx #f]
#:before [before ""]
#:between [between ""]
#:after [after ""]
. ts)
(datum->syntax
stx
(convert (combine-strings (to-string before)
(to-string between)
(to-string after)
(map to-string ts)))
stx
stx
stx))
(define text->string-literal (to-literal values))
(define text->identifier (to-literal string->symbol))
(define text->keyword-literal (to-literal string->keyword))
(define text->bytes-literal (to-literal string->bytes/utf-8))
(define text/c (flat-named-contract "text" text?))
(define (convert/c result/c)
(->* []
[#:before text/c #:between text/c #:after text/c]
#:rest (listof text/c)
result/c))
(define (convert-literal/c result/c)
(->* []
[#:before text/c
#:between text/c
#:after text/c
#:stx (or/c false/c syntax?)]
#:rest (listof text/c)
result/c))
(provide/contract
[text/c flat-contract?]
[text? (-> any/c boolean?)]
[string-literal? (-> any/c boolean?)]
[keyword-literal? (-> any/c boolean?)]
[bytes-literal? (-> any/c boolean?)]
[text=? (-> text/c text/c boolean?)]
[text>? (-> text/c text/c boolean?)]
[text>=? (-> text/c text/c boolean?)]
[text<? (-> text/c text/c boolean?)]
[text<=? (-> text/c text/c boolean?)]
[text->string (convert/c string?)]
[text->symbol (convert/c symbol?)]
[text->keyword (convert/c keyword?)]
[text->bytes (convert/c bytes?)]
[text->identifier (convert-literal/c identifier?)]
[text->string-literal (convert-literal/c string-literal?)]
[text->keyword-literal (convert-literal/c keyword-literal?)]
[text->bytes-literal (convert-literal/c bytes-literal?)])

63
collects/unstable/values.rkt
View File

@ -1,63 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MULTIPLE VALUES TOOLS
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax (values->list stx)
(syntax-case stx ()
[(vl expr)
(syntax/loc stx
(call-with-values (lambda () expr) list))]))
(define (map/list n f ls)
(cond
[(andmap null? ls) (build-list n (lambda (i) null))]
[(andmap pair? ls)
(let* ([vs (values->list (apply f (map car ls)))]
[k (length vs)])
(unless (= k n)
(error 'map/values
"~a produced ~a values, not ~a: ~e"
f k n vs))
(map cons vs (map/list n f (map cdr ls))))]
[else (error 'map/values "list lengths differ")]))
(define (map/values n f . ls)
(apply values (map/list n f ls)))
(define (map2 f . ls)
(apply values (map/list 2 f ls)))
(define (foldr/list f vs ls)
(cond
[(andmap null? ls) vs]
[(andmap pair? ls)
(values->list
(apply
f
(append
(map car ls)
(foldr/list f vs (map cdr ls)))))]
[else (error 'foldr/values "list lengths differ")]))
(define (foldr/values f vs . ls)
(apply values (foldr/list f vs ls)))
(define (foldl/list f vs ls)
(cond
[(andmap null? ls) vs]
[(andmap pair? ls)
(foldl/list
f
(values->list (apply f (append (map car ls) vs)))
(map cdr ls))]
[else (error 'foldl/values "list lengths differ")]))
(define (foldl/values f vs . ls)
(apply values (foldl/list f vs ls)))
(provide map2 map/values foldr/values foldl/values values->list)

87
collects/unstable/web.rkt
View File

@ -1,87 +0,0 @@
#lang racket/base
(require xml
racket/contract
unstable/function
unstable/text)
;; css/c : FlatContract
;; Recognizes representations of Cascading Style Sheets.
(define css/c (listof (cons/c text/c (listof (list/c text/c text/c)))))
(provide/contract
[css/c flat-contract?]
[css? (-> any/c boolean?)]
[write-css (->* [css/c] [output-port?] void?)])
;; A Cascading Style Sheet (CSS) is a (Listof StyleDefn)
;; A Style Definition (StyleDefn) is a (cons Selectors (Listof PropDefn))
;; A Selectors is a Selector or a (NonEmptyListof Selector)
;; A Selector is a Symbol or String
;; A Property Definition (PropDefn) is a (list PropName PropVal)
;; A Property Name (PropName) is a Symbol or String
;; A Property Value (PropVal) is a Symbol or String
;; css? : Any -> Boolean
;; Reports whether a value is a CSS.
(define css? (flat-contract-predicate css/c))
;; write-css : CSS [OutputPort] -> Void
;; Writes a CSS datastructure as a proper text Cascading Style Sheet.
(define write-css
(lambda/parameter (css [output #:param current-output-port])
(for-each write-style-defn css)))
;; write-style-defn : StyleDefn [OutputPort] -> Void
;; Writes a style definition to a Cascading Style Sheet.
(define write-style-defn
(lambda/parameter (style-defn [output #:param current-output-port])
(write-selector (car style-defn))
(display " {")
(for-each write-prop-defn (cdr style-defn))
(display " }\n")))
;; write-text : Text [OutputPort] -> Void
;; Writes a text field to a Cascading Style Sheet.
(define write-text
(lambda/parameter (text [output #:param current-output-port])
(display (text->string text))))
;; write-selector : Selector [OutputPort] -> Void
;; Writes a selector to a Cascading Style Sheet.
(define write-selector write-text)
;; write-prop-defn : PropDefn [OutputPort] -> Void
;; Writes a property definition to a Cascading Style Sheet.
(define write-prop-defn
(lambda/parameter (prop-defn [output #:param current-output-port])
(display " ")
(write-prop-name (car prop-defn))
(display " : ")
(write-prop-val (cadr prop-defn))
(display ";")))
;; write-prop-name : PropName [OutputPort] -> Void
;; Writes a property name to a Cascading Style Sheet.
(define write-prop-name write-text)
;; write-prop-val : PropVal [OutputPort] -> Void
;; Writes a property value to a Cascading Style Sheet.
(define write-prop-val write-text)
(provide/contract
[create-webpage (string? xexpr/c . -> . void?)]
[create-stylesheet (string? css/c . -> . void?)])
;; create-stylesheet : String CSS -> Void
;; Writes an individual stylesheet to a file.
(define (create-stylesheet filename css)
(let* ([out-port (open-output-file filename #:exists 'replace)])
(write-css css out-port)
(close-output-port out-port)))
;; create-webpage : String XExpr -> Void
;; Writes an individual webpage to a file.
(define (create-webpage filename xexpr)
(let* ([out-port (open-output-file filename #:exists 'replace)])
(write-xexpr xexpr out-port)
(close-output-port out-port)))