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
(require-for-syntax syntax/stx
"private/increader.rkt"
racket/private/increader
"cm-accomplice.rkt")
(require mzlib/etc)

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -11,7 +11,6 @@ PLANNED FEATURES:
racket/file
racket/match
raco/command-name
(only-in mzlib/string read-from-string)
"../config.rkt"
"planet-shared.rkt"
@ -23,6 +22,11 @@ PLANNED FEATURES:
(define displayer (make-parameter (λ () (show-installed-packages))))
(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?)
(make-directory* (PLANET-DIR))

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -4,7 +4,7 @@
;; the code and tests are a lot better than they would be.
(module char-set mzscheme
(require mzlib/integer-set
(require data/integer-set
racket/contract)
;; Data defn ----------------------------------------
@ -237,14 +237,14 @@
(case-lambda
[(cs 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))))))]
[(cs . more)
(fold-set char-set-delete cs more)]))
(define (char-set-complement cs)
(make-char-set
(difference (complement (char-set-set cs) 0 #x10FFFF)
(subtract (complement (char-set-set cs) 0 #x10FFFF)
(make-range #xD800 #xDFFF))))
(define-syntax define-set-op
@ -264,10 +264,10 @@
(define char-set-difference
(case-lambda
[(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)
(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
(case-lambda

View File

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

View File

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

View File

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