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
(require (only scheme/runtime-path define-runtime-path)
racket/port
mzlib/kw
unstable/port)
unstable/port
mzlib/kw)
(define input-map
`(
("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
(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 "dict-empty?"
(test (check-true (dict-empty? '())))
@ -69,24 +29,4 @@
(dict-union! d '([3 . three] [4 . four]))
(check-equal?
(hash-copy #hash([1 . one] [2 . two] [3 . three] [4 . four]))
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])))))))))
d))))))

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

@ -7,3 +7,34 @@
(remf even? '(1 -2 3 4 -5)) => '(1 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))
(read port)
(check-equal? (port->srcloc port 'here 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)))))
(make-srcloc 'here 2 2 4 1))))))

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
(require racket/dict racket/match racket/contract unstable/contract)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; "Missing" Functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require racket/dict
racket/contract)
(define (dict-empty? dict)
(not (dict-iterate-first dict)))
@ -15,118 +9,6 @@
;; make things worse, it's not even mentioned in the docs.)
;; 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)
(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)
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
[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?)]
[#:combine
(-> any/c any/c any/c)

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

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

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)
(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:

19
collects/unstable/port.rkt
View File

@ -3,24 +3,6 @@
racket/contract
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])
(let*-values ([(line col pos) (port-next-location port)])
(make-srcloc source line col pos span)))
@ -52,5 +34,4 @@ Ryan:
[read-all-syntax
(->* [] [(-> (or/c syntax? eof-object?)) input-port?]
(syntax/c list?))]
[read-available-bytes (->* [] [input-port?] (or/c bytes? eof-object?))]
[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
(require (for-syntax racket/base
racket/match
racket/require-transform
racket/provide-transform
syntax/parse
planet/syntax)
planet/version
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)))]))))
syntax/parse))
(provide require/provide
quote-require)
(define-syntax-rule (require/provide spec ...)
(begin
@ -90,38 +20,27 @@
(with-syntax ([(name ...) (map import-local-id imports)])
(syntax/loc stx '(name ...))))]))
;; rename-import : Import Identifier -> Import
;; Creates a new import that binds the given identifier, but otherwise acts as
;; the original import.
(define-for-syntax (rename-import i id)
(struct-copy import i [local-id id]))
(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))]))))
;; import->raw-require-spec : Import -> Syntax
;; Constructs a raw-require-spec (suitable for #%require) that should have the
;; same behavior as a require-spec that produces the given import.
(define-for-syntax (import->raw-require-spec i)
(match i
[(struct import [local-id
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)]))
(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)))
(provide require/provide
quote-require
define-planet-package
define-collection
this-package-in)
(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)))]))))

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.
@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?]{
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?)]
[d dict?] ...
[#: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/prefs.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"
(for-label racket/gui
drracket/tool-lib
unstable/class
unstable/gui/language-level))
@title{DrRacket Language Levels}
@ -30,7 +29,7 @@ This unit imports @scheme[drracket:tool^] and exports @scheme[language-level^].
[#:reader reader
(->* [] [any/c input-port?] (or/c syntax? eof-object?))
read-syntax])
(object-provides/c drracket:language:language<%>)]{
(is-a?/c drracket:language:language<%>)]{
Constructs a language level as an instance of
@scheme[drracket:language:language<%>] with the given @scheme[name] based on the
@ -43,9 +42,9 @@ reader.
}
@defthing[simple-language-level%
(class-provides/c drracket:language:language<%>
drracket:language:module-based-language<%>
drracket:language:simple-module-based-language<%>)]{
(and/c (implementation?/c drracket:language:language<%>)
(implementation?/c drracket:language:module-based-language<%>)
(implementation?/c drracket:language:simple-module-based-language<%>))]{
Equal to
@scheme[
@ -57,7 +56,7 @@ Equal to
@defproc[(language-level-render-mixin [to-sexp (-> any/c any/c)]
[show-void? boolean?])
(mixin-provides/c [drracket:language:language<%>] [])]{
(make-mixin-contract 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,
@ -67,7 +66,7 @@ and to skip @scheme[void?] values (pre-transformation) if @scheme[show-void?] is
}
@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<%>
capability-value] to look up each key in @scheme[dict], producing the
@ -77,7 +76,7 @@ otherwise.
}
@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
error message in a dialog box.
@ -85,9 +84,8 @@ error message in a dialog box.
}
@defthing[language-level-eval-as-module-mixin
(mixin-provides/c [drracket:language:language<%>
drracket:language:module-based-language<%>]
[])]{
(make-mixin-contract drracket:language:language<%>
drracket:language:module-based-language<%>)]{
Overrides @method[drracket:language:language<%> front-end/complete-program] to
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
(mixin-provides/c [drracket:language:language<%>]
[])]{
(make-mixin-contract drracket:language:language<%>)]{
This mixin enables the macro stepper for its language level.
}
@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
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->settings (-> string? any/c any/c)]
[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
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}
@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["class.scrbl"]
@include-section["contract.scrbl"]
@include-section["wrapc.scrbl"]
@include-section["prop-contract.scrbl"]
@include-section["debug.scrbl"]
@include-section["define.scrbl"]
@include-section["dict.scrbl"]
@include-section["dirs.scrbl"]
@include-section["exn.scrbl"]
@include-section["file.scrbl"]
@include-section["find.scrbl"]
@include-section["mutated-vars.scrbl"] ;; Finding Mutable Variables
@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["markparam.scrbl"]
@include-section["match.scrbl"]
@include-section["net.scrbl"]
@include-section["path.scrbl"]
@include-section["port.scrbl"]
@include-section["pretty.scrbl"]
@include-section["regexp.scrbl"]
@include-section["require.scrbl"]
@include-section["sandbox.scrbl"]
@include-section["sequence.scrbl"]
@include-section["set.scrbl"]
@include-section["sexp-diff.scrbl"]
@include-section["string.scrbl"]
@include-section["struct.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)))