Move much of mzlib
to compatibility-lib
package.
This commit is contained in:
parent
59c6519cd3
commit
7917f32d0c
|
@ -1,7 +1,7 @@
|
|||
|
||||
(module include mzscheme
|
||||
(require-for-syntax syntax/stx
|
||||
"private/increader.rkt"
|
||||
racket/private/increader
|
||||
"cm-accomplice.rkt")
|
||||
(require mzlib/etc)
|
||||
|
|
@ -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
|
|
@ -4,7 +4,7 @@
|
|||
(require (only racket/base sort)
|
||||
compatibility/mlist
|
||||
"pconvert-prop.rkt"
|
||||
"class.rkt")
|
||||
racket/class)
|
||||
|
||||
(provide show-sharing
|
||||
constructor-style-printing
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(module compiler mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(require "sig.rkt")
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
(require scheme/file
|
||||
scheme/path
|
||||
setup/dirs
|
||||
mzlib/list
|
||||
racket/list
|
||||
setup/variant
|
||||
dynext/filename-version
|
||||
"private/macfw.rkt"
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
(module embed-sig mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
(provide compiler:embed^)
|
||||
|
||||
(define-signature compiler:embed^
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
#lang mzscheme
|
||||
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
(require "sig.rkt")
|
||||
|
||||
(provide compiler:option@)
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(module option mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(require "sig.rkt"
|
||||
"option-unit.rkt")
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
#lang racket/base
|
||||
(require mzlib/port)
|
||||
(require racket/port)
|
||||
|
||||
(provide update-config-dir
|
||||
get-current-config-dir)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(module windlldir mzscheme
|
||||
(require mzlib/port
|
||||
(require racket/port
|
||||
"winutf16.rkt")
|
||||
|
||||
(provide update-dll-dir
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
#lang mzscheme
|
||||
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(provide compiler:option^
|
||||
compiler^)
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/etc
|
||||
scheme/match
|
||||
(require scheme/match
|
||||
scheme/contract
|
||||
scheme/list
|
||||
racket/set)
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
|
||||
(module compile-sig mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(provide dynext:compile^)
|
||||
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(module compile mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(require "compile-sig.rkt"
|
||||
"compile-unit.rkt")
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
(module file-sig mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(provide dynext:file^)
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(module file mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(require "file-sig.rkt"
|
||||
"file-unit.rkt")
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
|
||||
(module link-sig mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(provide dynext:link^)
|
||||
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(module link mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(require "link-sig.rkt"
|
||||
"link-unit.rkt")
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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")]))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -4,7 +4,6 @@
|
|||
racket/match
|
||||
unstable/syntax
|
||||
racket/syntax
|
||||
mzlib/etc
|
||||
"../planet-archives.rkt")
|
||||
|
||||
(provide this-package-version
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require (for-syntax racket/base
|
||||
syntax/path-spec
|
||||
mzlib/private/increader
|
||||
"private/increader.rkt"
|
||||
compiler/cm-accomplice))
|
||||
|
||||
(provide include
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
(module option-sig mzscheme
|
||||
(require mzlib/unit)
|
||||
(require racket/unit)
|
||||
|
||||
(provide setup-option^)
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
(module setup-go mzscheme
|
||||
(require "setup-cmdline.rkt"
|
||||
mzlib/unit
|
||||
racket/unit
|
||||
|
||||
"option-sig.rkt"
|
||||
"setup-unit.rkt"
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
(require mzlib/contract
|
||||
syntax/stx)
|
||||
|
||||
(require mzlib/list)
|
||||
(require racket/list)
|
||||
|
||||
(define (syntax->string c)
|
||||
(let* ([s (open-output-string)]
|
||||
|
|
|
@ -1,2 +1,2 @@
|
|||
(module trusted-xforms mzscheme
|
||||
(require mzlib/class))
|
||||
(require racket/class))
|
||||
|
|
Loading…
Reference in New Issue
Block a user