Move much of mzlib to compatibility-lib package.

This commit is contained in:
Sam Tobin-Hochstadt 2013-06-26 11:52:28 -04:00
parent 59c6519cd3
commit 7917f32d0c
95 changed files with 121 additions and 121 deletions

View File

@ -1,7 +1,7 @@
(module include mzscheme (module include mzscheme
(require-for-syntax syntax/stx (require-for-syntax syntax/stx
"private/increader.rkt" racket/private/increader
"cm-accomplice.rkt") "cm-accomplice.rkt")
(require mzlib/etc) (require mzlib/etc)

View File

@ -1,6 +1,6 @@
(module thread mzscheme (module thread mzscheme
(require "kw.rkt" "contract.rkt" racket/engine) (require mzlib/kw mzlib/contract racket/engine)
(provide run-server (provide run-server
consumer-thread consumer-thread

View File

@ -4,7 +4,7 @@
(require (only racket/base sort) (require (only racket/base sort)
compatibility/mlist compatibility/mlist
"pconvert-prop.rkt" "pconvert-prop.rkt"
"class.rkt") racket/class)
(provide show-sharing (provide show-sharing
constructor-style-printing constructor-style-printing

View File

@ -1,10 +1,11 @@
(module bundle-dist mzscheme (module bundle-dist mzscheme
(require mzlib/etc (require racket/file
mzlib/file (only racket/base lambda)
mzlib/process racket/path
mzlib/zip racket/system
mzlib/tar) file/zip
file/tar)
(provide bundle-put-file-extension+style+filters (provide bundle-put-file-extension+style+filters
bundle-directory) bundle-directory)
@ -61,7 +62,7 @@
(lambda () (delete-directory/files temp-dir)))))) (lambda () (delete-directory/files temp-dir))))))
(define bundle-directory (define bundle-directory
(opt-lambda (target dir [for-exe? #f]) (lambda (target dir [for-exe? #f])
(let ([target (add-suffix target (bundle-file-suffix))]) (let ([target (add-suffix target (bundle-file-suffix))])
(case (system-type) (case (system-type)
[(macosx) [(macosx)

View File

@ -8,7 +8,7 @@
(require (prefix-in compiler:option: "../option.rkt") (require (prefix-in compiler:option: "../option.rkt")
"../compiler.rkt" "../compiler.rkt"
raco/command-name raco/command-name
mzlib/cmdline racket/cmdline
dynext/file dynext/file
dynext/compile dynext/compile
dynext/link dynext/link

View File

@ -1,5 +1,5 @@
(module compiler mzscheme (module compiler mzscheme
(require mzlib/unit) (require racket/unit)
(require "sig.rkt") (require "sig.rkt")

View File

@ -2,7 +2,7 @@
(require scheme/file (require scheme/file
scheme/path scheme/path
setup/dirs setup/dirs
mzlib/list racket/list
setup/variant setup/variant
dynext/filename-version dynext/filename-version
"private/macfw.rkt" "private/macfw.rkt"

View File

@ -1,6 +1,6 @@
(module embed-sig mzscheme (module embed-sig mzscheme
(require mzlib/unit) (require racket/unit)
(provide compiler:embed^) (provide compiler:embed^)
(define-signature compiler:embed^ (define-signature compiler:embed^

View File

@ -25,7 +25,7 @@
"compiler.rkt") "compiler.rkt")
;; Read argv array for arguments and input file name ;; Read argv array for arguments and input file name
(require mzlib/cmdline (require racket/cmdline
dynext/file dynext/file
dynext/compile dynext/compile
dynext/link dynext/link

View File

@ -1,6 +1,6 @@
#lang mzscheme #lang mzscheme
(require mzlib/unit) (require racket/unit)
(require "sig.rkt") (require "sig.rkt")
(provide compiler:option@) (provide compiler:option@)

View File

@ -1,5 +1,5 @@
(module option mzscheme (module option mzscheme
(require mzlib/unit) (require racket/unit)
(require "sig.rkt" (require "sig.rkt"
"option-unit.rkt") "option-unit.rkt")

View File

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require mzlib/port) (require racket/port)
(provide update-config-dir (provide update-config-dir
get-current-config-dir) get-current-config-dir)

View File

@ -1,7 +1,8 @@
(module macfw mzscheme (module macfw mzscheme
(require "mach-o.rkt" (require "mach-o.rkt"
mzlib/string racket/string
mzlib/process) (only racket/base regexp-quote)
racket/system)
(provide update-framework-path (provide update-framework-path
get-current-framework-path get-current-framework-path

View File

@ -1,5 +1,5 @@
(module windlldir mzscheme (module windlldir mzscheme
(require mzlib/port (require racket/port
"winutf16.rkt") "winutf16.rkt")
(provide update-dll-dir (provide update-dll-dir

View File

@ -1,7 +1,7 @@
(module xform mzscheme (module xform mzscheme
(require mzlib/list (require racket/list
mzlib/etc (only racket/base sort filter remove let)
mzlib/process) racket/system)
(provide xform) (provide xform)
@ -17,7 +17,7 @@
(parameterize ([current-output-port (current-output-port)] ; because we mutate these... (parameterize ([current-output-port (current-output-port)] ; because we mutate these...
[error-escape-handler (error-escape-handler)] [error-escape-handler (error-escape-handler)]
[current-inspector (current-inspector)]) [current-inspector (current-inspector)])
(begin-with-definitions (let ()
(define power-inspector (current-inspector)) (define power-inspector (current-inspector))
(current-inspector (make-inspector)) (current-inspector (make-inspector))

View File

@ -1,7 +1,7 @@
#lang mzscheme #lang mzscheme
(require mzlib/unit) (require racket/unit)
(provide compiler:option^ (provide compiler:option^
compiler^) compiler^)

View File

@ -1,6 +1,5 @@
#lang scheme/base #lang scheme/base
(require mzlib/etc (require scheme/match
scheme/match
scheme/contract scheme/contract
scheme/list scheme/list
racket/set) racket/set)

View File

@ -1,6 +1,5 @@
(module compile-sig mzscheme (module compile-sig mzscheme
(require mzlib/unit) (require racket/unit)
(provide dynext:compile^) (provide dynext:compile^)

View File

@ -1,7 +1,6 @@
(module compile-unit mzscheme (module compile-unit mzscheme
(require mzlib/unit (require racket/unit
mzlib/process racket/system
mzlib/sendevent
"private/dirs.rkt" "private/dirs.rkt"
"private/stdio.rkt" "private/stdio.rkt"
"private/cmdargs.rkt") "private/cmdargs.rkt")

View File

@ -1,5 +1,5 @@
(module compile mzscheme (module compile mzscheme
(require mzlib/unit) (require racket/unit)
(require "compile-sig.rkt" (require "compile-sig.rkt"
"compile-unit.rkt") "compile-unit.rkt")

View File

@ -1,6 +1,6 @@
(module file-sig mzscheme (module file-sig mzscheme
(require mzlib/unit) (require racket/unit)
(provide dynext:file^) (provide dynext:file^)

View File

@ -1,5 +1,5 @@
(module file mzscheme (module file mzscheme
(require mzlib/unit) (require racket/unit)
(require "file-sig.rkt" (require "file-sig.rkt"
"file-unit.rkt") "file-unit.rkt")

View File

@ -1,6 +1,5 @@
(module link-sig mzscheme (module link-sig mzscheme
(require mzlib/unit) (require racket/unit)
(provide dynext:link^) (provide dynext:link^)

View File

@ -1,7 +1,6 @@
(module link-unit mzscheme (module link-unit mzscheme
(require mzlib/unit (require racket/unit
mzlib/process racket/system
mzlib/sendevent
"private/dirs.rkt" "private/dirs.rkt"
"private/stdio.rkt" "private/stdio.rkt"
"private/cmdargs.rkt" "private/cmdargs.rkt"

View File

@ -1,5 +1,5 @@
(module link mzscheme (module link mzscheme
(require mzlib/unit) (require racket/unit)
(require "link-sig.rkt" (require "link-sig.rkt"
"link-unit.rkt") "link-unit.rkt")

View File

@ -1,7 +1,8 @@
;; A modification of Dave Herman's zip module ;; A modification of Dave Herman's zip module
(module zip mzscheme (module zip mzscheme
(require mzlib/deflate racket/file mzlib/kw) (require file/gzip racket/file
(only racket/base define))
;; =========================================================================== ;; ===========================================================================
;; DATA DEFINITIONS ;; DATA DEFINITIONS
@ -246,7 +247,7 @@
;; zip-write : (listof relative-path) -> ;; zip-write : (listof relative-path) ->
;; writes a zip file to current-output-port ;; writes a zip file to current-output-port
(provide zip->output) (provide zip->output)
(define/kw (zip->output files #:optional [out (current-output-port)]) (define (zip->output files [out (current-output-port)])
(parameterize ([current-output-port out]) (parameterize ([current-output-port out])
(let* ([seekable? (seekable-port? (current-output-port))] (let* ([seekable? (seekable-port? (current-output-port))]
[headers ; note: Racket's `map' is always left-to-right [headers ; note: Racket's `map' is always left-to-right

View File

@ -11,7 +11,6 @@ PLANNED FEATURES:
racket/file racket/file
racket/match racket/match
raco/command-name raco/command-name
(only-in mzlib/string read-from-string)
"../config.rkt" "../config.rkt"
"planet-shared.rkt" "planet-shared.rkt"
@ -22,6 +21,11 @@ PLANNED FEATURES:
(define erase? (make-parameter #f)) (define erase? (make-parameter #f))
(define displayer (make-parameter (λ () (show-installed-packages)))) (define displayer (make-parameter (λ () (show-installed-packages))))
(define quiet-unlink? (make-parameter #f)) (define quiet-unlink? (make-parameter #f))
(define (read-from-string str)
(read
(if (bytes? str) (open-input-bytes str) (open-input-string str))))
(define (start raco?) (define (start raco?)

View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require mzlib/match (require racket/match
"short-syntax-helpers.rkt" "short-syntax-helpers.rkt"
"data.rkt") "data.rkt")
@ -52,7 +52,7 @@
;; maps the given require spec to a planet package request structure ;; maps the given require spec to a planet package request structure
(define (spec->req spec stx) (define (spec->req spec stx)
(match (cdr spec) (match (cdr spec)
[(file-name pkg-spec path ...) [(list file-name pkg-spec path ...)
(unless (string? file-name) (unless (string? file-name)
(raise-syntax-error #f (format "File name: expected a string, received: ~s" file-name) stx)) (raise-syntax-error #f (format "File name: expected a string, received: ~s" file-name) stx))
(unless (andmap string? path) (unless (andmap string? path)
@ -63,7 +63,7 @@
(make-request (pkg-spec->full-pkg-spec pkg-spec stx) (make-request (pkg-spec->full-pkg-spec pkg-spec stx)
file-name file-name
path)] path)]
[((? (lambda (x) (or (symbol? x) (string? x))) s)) [(list (? (lambda (x) (or (symbol? x) (string? x))) s))
(let ([str (if (symbol? s) (symbol->string s) s)]) (let ([str (if (symbol? s) (symbol->string s) s)])
(define (yell msg) (λ (str) (raise-syntax-error #f (format msg str) stx))) (define (yell msg) (λ (str) (raise-syntax-error #f (format msg str) stx)))
(let* ([pkg-spec/tail (short-pkg-string->spec str yell)] (let* ([pkg-spec/tail (short-pkg-string->spec str yell)]
@ -101,12 +101,12 @@
(fail* (format "Invalid PLaneT package specifier: ~e" spec))) (fail* (format "Invalid PLaneT package specifier: ~e" spec)))
(match spec (match spec
[((? string? owner) (? string? package) ver-spec ...) [(list (? string? owner) (? string? package) ver-spec ...)
(match-let ([(maj min-lo min-hi) (version->bounds ver-spec fail*)]) (match-let ([(list maj min-lo min-hi) (version->bounds ver-spec fail*)])
(pkg package maj min-lo min-hi (list owner)))] (pkg package maj min-lo min-hi (list owner)))]
[((? (o not string?) owner) _ ...) [(list (? (o not string?) owner) _ ...)
(fail* (format "Expected string [package owner] in first position, received: ~e" owner))] (fail* (format "Expected string [package owner] in first position, received: ~e" owner))]
[(_ (? (o not string?) pkg) _ ...) [(list _ (? (o not string?) pkg) _ ...)
(fail* (format "Expected string [package name] in second position, received: ~e" pkg))] (fail* (format "Expected string [package name] in second position, received: ~e" pkg))]
[_ (fail)])) [_ (fail)]))
@ -117,37 +117,37 @@
;; be in a list by itself, because that's slightly more convenient for the above fn] ;; be in a list by itself, because that's slightly more convenient for the above fn]
(define (version->bounds spec-list fail) (define (version->bounds spec-list fail)
(match spec-list (match spec-list
[() (list #f 0 #f)] [(list) (list #f 0 #f)]
[(? number? maj) (version->bounds (list maj))] [(? number? maj) (version->bounds (list maj))]
[((? number? maj)) (list maj 0 #f)] [(list (? number? maj)) (list maj 0 #f)]
[((? number? maj) min-spec) [(list (? number? maj) min-spec)
(let ((pkg (lambda (min max) (list maj min max)))) (let ((pkg (lambda (min max) (list maj min max))))
(match min-spec (match min-spec
[(? number? min) (pkg min #f)] [(? number? min) (pkg min #f)]
[((? number? lo) (? number? hi)) (pkg lo hi)] [(list (? number? lo) (? number? hi)) (pkg lo hi)]
[('= (? number? min)) (pkg min min)] [(list '= (? number? min)) (pkg min min)]
[('+ (? number? min)) (pkg min #f)] [(list '+ (? number? min)) (pkg min #f)]
[('- (? number? min)) (pkg 0 min)] [(list '- (? number? min)) (pkg 0 min)]
;; failure cases ;; failure cases
[(? (o/and (o not number?) [(? (o/and (o not number?)
(o/or (o not list?) (o/or (o not list?)
(λ (x) (not (= (length x) 2)))))) (λ (x) (not (= (length x) 2))))))
(fail (format "Expected number or version range specifier for minor version specification, received: ~e" min-spec))] (fail (format "Expected number or version range specifier for minor version specification, received: ~e" min-spec))]
[((? (λ (x) [(list (? (λ (x)
(and (not (number? x)) (and (not (number? x))
(not (memq x '(= + -))))) (not (memq x '(= + -)))))
range) range)
_) _)
(fail (format "Illegal range specifier in minor version specification. Legal range specifiers are numbers, =, +, -; given: ~e" range))] (fail (format "Illegal range specifier in minor version specification. Legal range specifiers are numbers, =, +, -; given: ~e" range))]
[(_ (? (o not number?) bnd)) [(list _ (? (o not number?) bnd))
(fail (format "Expected number as range bound in minor version specification, given: ~e" bnd))] (fail (format "Expected number as range bound in minor version specification, given: ~e" bnd))]
[_ (fail (format "Illegal minor version specification: ~e" min-spec))]))] [_ (fail (format "Illegal minor version specification: ~e" min-spec))]))]
;; failure cases ;; failure cases
[(? (o/and (o not number?) (o not list?)) v) [(? (o/and (o not number?) (o not list?)) v)
(fail (format "Version specification expected number or sequence, received: ~e" v))] (fail (format "Version specification expected number or sequence, received: ~e" v))]
[((? (o not number?) maj) _ ...) [(list (? (o not number?) maj) _ ...)
(fail (format "Version specification expected number for major version, received: ~e" maj))] (fail (format "Version specification expected number for major version, received: ~e" maj))]
[_ (fail "Invalid version specification")])) [_ (fail "Invalid version specification")]))

View File

@ -6,7 +6,7 @@ Various common pieces of code that both the client and server need to access
|# |#
(require (only-in racket/path path-only) (require (only-in racket/path path-only)
mzlib/port racket/port
racket/file racket/file
setup/getinfo setup/getinfo
(prefix-in srfi1: srfi/1) (prefix-in srfi1: srfi/1)

View File

@ -4,7 +4,6 @@
racket/match racket/match
unstable/syntax unstable/syntax
racket/syntax racket/syntax
mzlib/etc
"../planet-archives.rkt") "../planet-archives.rkt")
(provide this-package-version (provide this-package-version

View File

@ -2,7 +2,7 @@
(require (for-syntax racket/base (require (for-syntax racket/base
syntax/path-spec syntax/path-spec
mzlib/private/increader "private/increader.rkt"
compiler/cm-accomplice)) compiler/cm-accomplice))
(provide include (provide include

View File

@ -1,6 +1,5 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base) (require (for-syntax racket/base)
mzlib/etc
racket/contract/base racket/contract/base
racket/contract/combinator racket/contract/combinator
(only-in racket/contract/region current-contract-region) (only-in racket/contract/region current-contract-region)
@ -2455,9 +2454,9 @@
(vector-set! super-methods index method) (vector-set! super-methods index method)
(vector-set! int-methods index (vector method)) (vector-set! int-methods index (vector method))
(vector-set! beta-methods index (vector)) (vector-set! beta-methods index (vector))
(vector-set! inner-projs index identity) (vector-set! inner-projs index values)
(vector-set! dynamic-idxs index 0) (vector-set! dynamic-idxs index 0)
(vector-set! dynamic-projs index (vector identity))) (vector-set! dynamic-projs index (vector values)))
(append new-augonly-indices new-final-indices (append new-augonly-indices new-final-indices
new-abstract-indices new-normal-indices) new-abstract-indices new-normal-indices)
new-methods) new-methods)
@ -2517,7 +2516,7 @@
(let ([v (list->vector (append (vector->list (vector-ref beta-methods index)) (let ([v (list->vector (append (vector->list (vector-ref beta-methods index))
(list #f)))]) (list #f)))])
;; Since this starts a new part of the chain, reset the projection. ;; Since this starts a new part of the chain, reset the projection.
(vector-set! inner-projs index identity) (vector-set! inner-projs index values)
(vector-set! beta-methods index v)))) (vector-set! beta-methods index v))))
augonly-names) augonly-names)
;; Mark final methods: ;; Mark final methods:
@ -3114,7 +3113,7 @@ An example
[old-int-vec (vector-ref int-methods i)]) [old-int-vec (vector-ref int-methods i)])
(vector-set! dynamic-idxs i new-idx) (vector-set! dynamic-idxs i new-idx)
(vector-copy! new-proj-vec 0 old-proj-vec) (vector-copy! new-proj-vec 0 old-proj-vec)
(vector-set! new-proj-vec new-idx identity) (vector-set! new-proj-vec new-idx values)
(vector-set! dynamic-projs i new-proj-vec) (vector-set! dynamic-projs i new-proj-vec)
(vector-copy! new-int-vec 0 old-int-vec) (vector-copy! new-int-vec 0 old-int-vec)
;; Just copy over the last entry here. We'll ;; Just copy over the last entry here. We'll
@ -4760,7 +4759,7 @@ An example
"class" c))) "class" c)))
(define object->vector (define object->vector
(opt-lambda (in-o [opaque-v '...]) (lambda (in-o [opaque-v '...])
(unless (object? in-o) (unless (object? in-o)
(raise-argument-error 'object->vector "object?" in-o)) (raise-argument-error 'object->vector "object?" in-o))
(let ([o in-o]) (let ([o in-o])

View File

@ -1,8 +1,9 @@
(module trait mzscheme (module trait mzscheme
(require mzlib/class (require racket/class
mzlib/list racket/list
mzlib/struct) (only racket/base sort filter struct-copy))
(require-for-syntax mzlib/list (require-for-syntax racket/list
(only racket/base filter)
syntax/stx syntax/stx
syntax/boundmap syntax/boundmap
syntax/kerncase syntax/kerncase
@ -657,8 +658,8 @@
(validate-trait (validate-trait
'trait-alias 'trait-alias
(make-trait (make-trait
(cons (copy-struct method m (cons (struct-copy method m
[method-name new-name]) [name new-name])
(trait-methods t)) (trait-methods t))
(trait-fields t))))) (trait-fields t)))))
@ -673,11 +674,11 @@
'trait-rename 'trait-rename
(make-trait (make-trait
(map (lambda (m) (map (lambda (m)
(copy-struct method m (struct-copy method m
[method-name (rename (method-name m))] [name (rename (method-name m))]
[method-need-inherit (map rename (method-need-inherit m))] [need-inherit (map rename (method-need-inherit m))]
[method-need-super (map rename (method-need-super m))] [need-super (map rename (method-need-super m))]
[method-need-inner (map rename (method-need-inner m))])) [need-inner (map rename (method-need-inner m))]))
(trait-methods t)) (trait-methods t))
(trait-fields t))))) (trait-fields t)))))
@ -692,12 +693,12 @@
'trait-rename 'trait-rename
(make-trait (make-trait
(map (lambda (m) (map (lambda (m)
(copy-struct method m (struct-copy method m
[method-need-field (map rename (method-need-field m))])) [need-field (map rename (method-need-field m))]))
(trait-methods t)) (trait-methods t))
(map (lambda (f) (map (lambda (f)
(copy-struct feeld f (struct-copy feeld f
[feeld-name (rename (feeld-name f))])) [name (rename (feeld-name f))]))
(trait-fields t)))))) (trait-fields t))))))
(define-syntax define-trait-alias (define-syntax define-trait-alias

View File

@ -1,6 +1,6 @@
(module option-sig mzscheme (module option-sig mzscheme
(require mzlib/unit) (require racket/unit)
(provide setup-option^) (provide setup-option^)

View File

@ -1,6 +1,6 @@
(module setup-go mzscheme (module setup-go mzscheme
(require "setup-cmdline.rkt" (require "setup-cmdline.rkt"
mzlib/unit racket/unit
"option-sig.rkt" "option-sig.rkt"
"setup-unit.rkt" "setup-unit.rkt"

View File

@ -3,7 +3,7 @@
#lang scheme/base #lang scheme/base
(require mzlib/file "main-collects.rkt" "dirs.rkt") (require racket/file "main-collects.rkt" "dirs.rkt")
(define (make-copy) (define (make-copy)
(let* ([tmpdir (find-system-path 'temp-dir)] (let* ([tmpdir (find-system-path 'temp-dir)]

View File

@ -88,10 +88,9 @@
#lang mzscheme #lang mzscheme
(require srfi/optional (require srfi/optional
(only racket/base lambda)
srfi/8/receive srfi/8/receive
srfi/14/char-set srfi/14/char-set)
mzlib/etc ; for opt-lambda (instead of let-optionals*)
)
(provide (provide
;; String procedures: ;; String procedures:
string-map string-map! string-map string-map!
@ -397,7 +396,7 @@
;; chars over from the chunk buffers. ;; chars over from the chunk buffers.
(define string-unfold (define string-unfold
(opt-lambda (p f g seed (base "") (make-final (lambda (x) ""))) (lambda (p f g seed (base "") (make-final (lambda (x) "")))
(check-arg procedure? p 'string-unfold) (check-arg procedure? p 'string-unfold)
(check-arg procedure? f 'string-unfold) (check-arg procedure? f 'string-unfold)
(check-arg procedure? g 'string-unfold) (check-arg procedure? g 'string-unfold)
@ -445,7 +444,7 @@
ans)))))) ans))))))
(define string-unfold-right (define string-unfold-right
(opt-lambda (p f g seed (base "") (make-final (lambda (x) ""))) (lambda (p f g seed (base "") (make-final (lambda (x) "")))
(check-arg string? base 'string-unfold-right) (check-arg string? base 'string-unfold-right)
(check-arg procedure? make-final 'string-unfold-right) (check-arg procedure? make-final 'string-unfold-right)
(let lp ((chunks '()) ; Previously filled chunks (let lp ((chunks '()) ; Previously filled chunks
@ -897,7 +896,7 @@
;; Hash ;; Hash
(define string-hash (define string-hash
(opt-lambda (s (bound 0) . rest) (lambda (s (bound 0) . rest)
(check-arg (lambda (x) (check-arg (lambda (x)
(and (integer? x) (and (integer? x)
(exact? x) (exact? x)
@ -913,7 +912,7 @@
(apply substring/shared s rest)))))) (apply substring/shared s rest))))))
(define string-hash-ci (define string-hash-ci
(opt-lambda (s (bound 0) . rest) (lambda (s (bound 0) . rest)
(check-arg (lambda (x) (check-arg (lambda (x)
(and (integer? x) (and (integer? x)
(exact? x) (exact? x)
@ -1031,21 +1030,21 @@
(define string-trim (define string-trim
(opt-lambda (s (criterion char-set:whitespace) . rest) (lambda (s (criterion char-set:whitespace) . rest)
(let-string-start+end (start end) 'string-trim s rest (let-string-start+end (start end) 'string-trim s rest
(cond ((string-skip s criterion start end) (cond ((string-skip s criterion start end)
=> (lambda (i) (%substring/shared s i end))) => (lambda (i) (%substring/shared s i end)))
(else ""))))) (else "")))))
(define string-trim-right (define string-trim-right
(opt-lambda (s (criterion char-set:whitespace) . rest) (lambda (s (criterion char-set:whitespace) . rest)
(let-string-start+end (start end) 'string-trim-right s rest (let-string-start+end (start end) 'string-trim-right s rest
(cond ((string-skip-right s criterion start end) (cond ((string-skip-right s criterion start end)
=> (lambda (i) (%substring/shared s 0 (+ 1 i)))) => (lambda (i) (%substring/shared s 0 (+ 1 i))))
(else ""))))) (else "")))))
(define string-trim-both (define string-trim-both
(opt-lambda (s (criterion char-set:whitespace) . rest) (lambda (s (criterion char-set:whitespace) . rest)
(let-string-start+end (start end) 'string-trim-both s rest (let-string-start+end (start end) 'string-trim-both s rest
(cond ((string-skip s criterion start end) (cond ((string-skip s criterion start end)
=> (lambda (i) => (lambda (i)
@ -1053,7 +1052,7 @@
(else ""))))) (else "")))))
(define string-pad-right (define string-pad-right
(opt-lambda (s n (char #\space) . rest) (lambda (s n (char #\space) . rest)
(check-arg char? char 'string-pad-right) (check-arg char? char 'string-pad-right)
(let-string-start+end (start end) 'string-pad-right s rest (let-string-start+end (start end) 'string-pad-right s rest
(check-arg (lambda (n) (and (integer? n) (exact? n) (<= 0 n))) (check-arg (lambda (n) (and (integer? n) (exact? n) (<= 0 n)))
@ -1066,7 +1065,7 @@
ans)))))) ans))))))
(define string-pad (define string-pad
(opt-lambda (s n (char #\space) . rest) (lambda (s n (char #\space) . rest)
(check-arg char? char 'string-pad) (check-arg char? char 'string-pad)
(let-string-start+end (start end) 'string-pad s rest (let-string-start+end (start end) 'string-pad s rest
(check-arg (lambda (n) (and (integer? n) (exact? n) (<= 0 n))) (check-arg (lambda (n) (and (integer? n) (exact? n) (<= 0 n)))
@ -1454,7 +1453,7 @@
;; for speed. ;; for speed.
(define string-kmp-partial-search (define string-kmp-partial-search
(opt-lambda (pat rv s i (c= char=?) (p-start 0) . start+end) (lambda (pat rv s i (c= char=?) (p-start 0) . start+end)
(check-arg procedure? c= 'string-kmp-partial-search) (check-arg procedure? c= 'string-kmp-partial-search)
(check-arg vector? rv 'string-kmp-partial-search) (check-arg vector? rv 'string-kmp-partial-search)
(check-arg (lambda (x) (check-arg (lambda (x)
@ -1609,7 +1608,7 @@
;; (cons (substring final-string 0 end) string-list))) ;; (cons (substring final-string 0 end) string-list)))
(define string-concatenate-reverse (define string-concatenate-reverse
(opt-lambda (string-list (final "") (end (string-length final))) (lambda (string-list (final "") (end (string-length final)))
(check-arg string? final 'string-concatenate-reverse) (check-arg string? final 'string-concatenate-reverse)
(check-arg (lambda (x) (check-arg (lambda (x)
(and (integer? x) (exact? x) (<= 0 x (string-length final)))) (and (integer? x) (exact? x) (<= 0 x (string-length final))))
@ -1622,7 +1621,7 @@
(%finish-string-concatenate-reverse len string-list final end)))) (%finish-string-concatenate-reverse len string-list final end))))
(define string-concatenate-reverse/shared (define string-concatenate-reverse/shared
(opt-lambda (string-list (final "") (end (string-length final))) (lambda (string-list (final "") (end (string-length final)))
(check-arg string? final 'string-concatenate-reverse/shared) (check-arg string? final 'string-concatenate-reverse/shared)
(check-arg (lambda (x) (check-arg (lambda (x)
(and (integer? x) (exact? x) (<= 0 x (string-length final)))) (and (integer? x) (exact? x) (<= 0 x (string-length final))))
@ -1686,7 +1685,7 @@
;; (string-tokenize "hello, world") => ("hello," "world") ;; (string-tokenize "hello, world") => ("hello," "world")
(define string-tokenize (define string-tokenize
(opt-lambda (s (token-chars char-set:graphic) . rest) (lambda (s (token-chars char-set:graphic) . rest)
(check-arg char-set? token-chars 'string-tokenize) (check-arg char-set? token-chars 'string-tokenize)
(let-string-start+end (start end) 'string-tokenize s rest (let-string-start+end (start end) 'string-tokenize s rest
(let lp ((i end) (ans '())) (let lp ((i end) (ans '()))
@ -1842,7 +1841,7 @@
;; STRING-CONCATENATE is less efficient. ;; STRING-CONCATENATE is less efficient.
(define string-join (define string-join
(opt-lambda (strings (delim " ") (grammar 'infix)) (lambda (strings (delim " ") (grammar 'infix))
(check-arg string? delim 'string-join) (check-arg string? delim 'string-join)
(let ((buildit (lambda (lis final) (let ((buildit (lambda (lis final)
(let recur ((lis lis)) (let recur ((lis lis))

View File

@ -4,7 +4,7 @@
;; the code and tests are a lot better than they would be. ;; the code and tests are a lot better than they would be.
(module char-set mzscheme (module char-set mzscheme
(require mzlib/integer-set (require data/integer-set
racket/contract) racket/contract)
;; Data defn ---------------------------------------- ;; Data defn ----------------------------------------
@ -237,15 +237,15 @@
(case-lambda (case-lambda
[(cs char1) [(cs char1)
(let ([v (char->integer char1)]) (let ([v (char->integer char1)])
(make-char-set (difference (char-set-set cs) (make-char-set (subtract (char-set-set cs)
(make-integer-set (list (cons v v))))))] (make-integer-set (list (cons v v))))))]
[(cs . more) [(cs . more)
(fold-set char-set-delete cs more)])) (fold-set char-set-delete cs more)]))
(define (char-set-complement cs) (define (char-set-complement cs)
(make-char-set (make-char-set
(difference (complement (char-set-set cs) 0 #x10FFFF) (subtract (complement (char-set-set cs) 0 #x10FFFF)
(make-range #xD800 #xDFFF)))) (make-range #xD800 #xDFFF))))
(define-syntax define-set-op (define-syntax define-set-op
(syntax-rules () (syntax-rules ()
@ -264,10 +264,10 @@
(define char-set-difference (define char-set-difference
(case-lambda (case-lambda
[(cs1 cs2) [(cs1 cs2)
(make-char-set (difference (char-set-set cs1) (char-set-set cs2)))] (make-char-set (subtract (char-set-set cs1) (char-set-set cs2)))]
[(cs1 . more) [(cs1 . more)
(fold-set char-set-difference cs1 more)])) (fold-set char-set-difference cs1 more)]))
(define-set-op char-set-xor xor char-set:empty) (define-set-op char-set-xor symmetric-difference char-set:empty)
(define char-set-diff+intersection (define char-set-diff+intersection
(case-lambda (case-lambda

View File

@ -1,9 +1,9 @@
(module localization mzscheme (module localization mzscheme
(require mzlib/contract (require mzlib/contract
mzlib/file racket/file
mzlib/runtime-path (only racket/runtime-path define-runtime-path)
mzlib/string racket/string racket/format
syntax/modread) syntax/modread)
(provide/contract (current-language (parameter/c symbol?)) (provide/contract (current-language (parameter/c symbol?))
@ -55,7 +55,7 @@
(define (make-name bundle-specifier) (define (make-name bundle-specifier)
(string->symbol (string->symbol
(string-append "srfi-29:" (string-append "srfi-29:"
(expr->string bundle-specifier)))) (~v bundle-specifier))))
(define (declare-bundle! bundle-specifier bundle-assoc-list) (define (declare-bundle! bundle-specifier bundle-assoc-list)
(hash-table-put! *localization-bundles* bundle-specifier bundle-assoc-list)) (hash-table-put! *localization-bundles* bundle-specifier bundle-assoc-list))

View File

@ -2,7 +2,7 @@
(require mzlib/contract (require mzlib/contract
syntax/stx) syntax/stx)
(require mzlib/list) (require racket/list)
(define (syntax->string c) (define (syntax->string c)
(let* ([s (open-output-string)] (let* ([s (open-output-string)]

View File

@ -1,2 +1,2 @@
(module trusted-xforms mzscheme (module trusted-xforms mzscheme
(require mzlib/class)) (require racket/class))