Some reformating. The only real change is using `write-bytes' instead
of a `display' in one place.
This commit is contained in:
Eli Barzilay
parent
3ecdd3bc59
commit
5754312120
|
|
@ -15,14 +15,13 @@
|
|||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (real->decimal-string n [digits 2])
|
||||
(unless (exact-nonnegative-integer? digits)
|
||||
(raise-type-error 'real->decimal-string "exact-nonnegative-integer" digits))
|
||||
(raise-type-error 'real->decimal-string "exact-nonnegative-integer"
|
||||
digits))
|
||||
(let* ([e (expt 10 digits)]
|
||||
[num (round (abs (* e (inexact->exact n))))])
|
||||
(format "~a~a.~a"
|
||||
(if (or (negative? n)
|
||||
(equal? n -0.0))
|
||||
"-"
|
||||
"")
|
||||
(format
|
||||
"~a~a.~a"
|
||||
(if (or (negative? n) (equal? n -0.0)) "-" "")
|
||||
(quotient num e)
|
||||
(if (zero? digits)
|
||||
""
|
||||
|
|
@ -87,39 +86,38 @@
|
|||
(or (hash-ref t key #f)
|
||||
(let ([rx* (run-tweak)]) (hash-set! t key rx*) rx*))))))
|
||||
|
||||
(define (regexp-try-match pattern input-port [start-k 0] [end-k #f] [out #f] [prefix #""])
|
||||
(define (regexp-try-match pattern input-port [start-k 0] [end-k #f] [out #f]
|
||||
[prefix #""])
|
||||
(unless (input-port? input-port)
|
||||
(raise-type-error 'regexp-try-match
|
||||
"input port" input-port))
|
||||
(raise-type-error 'regexp-try-match "input port" input-port))
|
||||
(unless (or (not out) (output-port? out))
|
||||
(raise-type-error 'regexp-try-match
|
||||
"output port or #f" out))
|
||||
(let ([m (regexp-match-peek-positions pattern input-port start-k end-k #f prefix)])
|
||||
(raise-type-error 'regexp-try-match "output port or #f" out))
|
||||
(let ([m (regexp-match-peek-positions pattern input-port start-k end-k #f
|
||||
prefix)])
|
||||
(and m
|
||||
;; What happens if someone swipes our bytes before we can get them?
|
||||
(let ([drop (caar m)])
|
||||
;; drop prefix before match:
|
||||
(let ([s (read-bytes drop input-port)])
|
||||
(when out
|
||||
(display s out)))
|
||||
(when out (write-bytes s out)))
|
||||
;; Get the matching part, and shift matching indices
|
||||
(let ([s (read-bytes (- (cdar m) drop) input-port)])
|
||||
(cons s
|
||||
(map (lambda (p)
|
||||
(and p (subbytes s (- (car p) drop) (- (cdr p) drop))))
|
||||
(and p (subbytes s (- (car p) drop)
|
||||
(- (cdr p) drop))))
|
||||
(cdr m))))))))
|
||||
|
||||
;; Helper macro for the regexp functions below, with some utilities.
|
||||
(define (bstring-length s)
|
||||
(if (bytes? s) (bytes-length s) (string-length s)))
|
||||
(define no-empty-edge-matches
|
||||
(make-regexp-tweaker (lambda (rx n)
|
||||
(make-regexp-tweaker
|
||||
(lambda (rx n)
|
||||
(if (bytes? rx)
|
||||
(bytes-append #"(?:"
|
||||
rx
|
||||
#")(?<=" (make-bytes n (char->integer #\.)) #")")
|
||||
(format "(?:~a)(?<=~a)"
|
||||
rx (make-bytes n (char->integer #\.)))))))
|
||||
(bytes-append #"(?:" rx #")(?<="
|
||||
(make-bytes n (char->integer #\.)) #")")
|
||||
(format "(?:~a)(?<=~a)" rx (make-bytes n (char->integer #\.)))))))
|
||||
(define-syntax-rule (regexp-loop
|
||||
name loop start end pattern string
|
||||
ipre
|
||||
|
|
@ -134,12 +132,13 @@
|
|||
[len (cond [(string? string) (string-length string)]
|
||||
[(bytes? string) (bytes-length string)]
|
||||
[else #f])]
|
||||
[orig-rx (cond [(bytes? pattern) (byte-regexp pattern)]
|
||||
[orig-rx
|
||||
(cond [(bytes? pattern) (byte-regexp pattern)]
|
||||
[(string? pattern) (regexp pattern)]
|
||||
[(regexp? pattern) pattern]
|
||||
[(byte-regexp? pattern) pattern]
|
||||
[else
|
||||
(raise-type-error 'name
|
||||
[else (raise-type-error
|
||||
'name
|
||||
"regexp, byte regexp, string, or byte string"
|
||||
pattern)])]
|
||||
[max-lookbehind (regexp-max-lookbehind orig-rx)])
|
||||
|
|
@ -172,9 +171,10 @@
|
|||
end))
|
||||
(reverse
|
||||
(let loop ([acc '()] [start start] [end end] [ipre ipre] [0-ok? #t])
|
||||
(let* ([rx (if 0-ok?
|
||||
(let ([rx (if 0-ok?
|
||||
orig-rx
|
||||
(no-empty-edge-matches orig-rx (add1 (bytes-length ipre))))])
|
||||
(no-empty-edge-matches orig-rx
|
||||
(add1 (bytes-length ipre))))])
|
||||
(if (and port-success-choose (input-port? string))
|
||||
|
||||
;; Input port match, get string
|
||||
|
|
@ -198,8 +198,8 @@
|
|||
c))
|
||||
void))]
|
||||
[end (and end (- end start))])
|
||||
(let-values ([(ms ipre) (regexp-match/end rx
|
||||
string 0 end spitout ipre
|
||||
(let-values ([(ms ipre)
|
||||
(regexp-match/end rx string 0 end spitout ipre
|
||||
max-lookbehind)])
|
||||
(let* ([m (and ms (car ms))]
|
||||
[discarded/leftovers (if need-leftover?
|
||||
|
|
@ -209,8 +209,7 @@
|
|||
(bstring-length discarded/leftovers)
|
||||
discarded/leftovers)]
|
||||
[got (and m (bstring-length m))]
|
||||
[end (and end m
|
||||
(- end skipped got))])
|
||||
[end (and end m (- end skipped got))])
|
||||
(if m
|
||||
(let ([0-ok? (not (zero? got))])
|
||||
(loop (port-success-choose m discarded/leftovers ms acc)
|
||||
|
|
@ -220,11 +219,11 @@
|
|||
;; String/port match, get positions
|
||||
(let-values ([(m ipre)
|
||||
(if peek?
|
||||
(regexp-match-peek-positions/end rx
|
||||
string start end #f ipre
|
||||
(regexp-match-peek-positions/end
|
||||
rx string start end #f ipre
|
||||
max-lookbehind)
|
||||
(regexp-match-positions/end rx
|
||||
string start end #f ipre
|
||||
(regexp-match-positions/end
|
||||
rx string start end #f ipre
|
||||
max-lookbehind))])
|
||||
(if (not m)
|
||||
(failure-k acc start end)
|
||||
|
|
@ -241,10 +240,7 @@
|
|||
|
||||
;; Returns all the positions at which the pattern matched.
|
||||
(define (regexp-match-positions* pattern string [start 0] [end #f] [ipre #""])
|
||||
(regexp-loop
|
||||
regexp-match-positions* loop start end
|
||||
pattern string
|
||||
ipre
|
||||
(regexp-loop regexp-match-positions* loop start end pattern string ipre
|
||||
;; success-choose:
|
||||
(lambda (start mstart mend ms acc) (cons (cons mstart mend) acc))
|
||||
;; failure-k:
|
||||
|
|
@ -265,11 +261,10 @@
|
|||
#f))
|
||||
|
||||
;; Returns all the positions at which the pattern matched.
|
||||
(define (regexp-match-peek-positions* pattern string [start 0] [end #f] [ipre #""])
|
||||
(regexp-loop
|
||||
regexp-match-peek-positions* loop start end
|
||||
pattern string
|
||||
ipre
|
||||
(define (regexp-match-peek-positions* pattern string [start 0] [end #f]
|
||||
[ipre #""])
|
||||
(regexp-loop regexp-match-peek-positions* loop start end
|
||||
pattern string ipre
|
||||
;; success-choose:
|
||||
(lambda (start mstart mend ms acc) (cons (cons mstart mend) acc))
|
||||
;; failure-k:
|
||||
|
|
@ -284,13 +279,14 @@
|
|||
;; Splits a string into a list by removing any piece which matches
|
||||
;; the pattern.
|
||||
(define (regexp-split pattern string [start 0] [end #f] [ipre #""])
|
||||
(define buf (if (and (string? string) (or (byte-regexp? pattern)
|
||||
(bytes? pattern)))
|
||||
(define buf
|
||||
(if (and (string? string) (or (byte-regexp? pattern) (bytes? pattern)))
|
||||
(string->bytes/utf-8 string (char->integer #\?))
|
||||
string))
|
||||
(define sub (if (or (bytes? buf) (and (path? string)
|
||||
(or (bytes? pattern)
|
||||
(byte-regexp? pattern))))
|
||||
(define sub
|
||||
(if (or (bytes? buf)
|
||||
(and (path? string)
|
||||
(or (bytes? pattern) (byte-regexp? pattern))))
|
||||
subbytes
|
||||
substring))
|
||||
(regexp-loop regexp-split loop start end pattern buf ipre
|
||||
|
|
@ -312,32 +308,32 @@
|
|||
(define -regexp-replace*
|
||||
(let ([regexp-replace*
|
||||
(lambda (pattern string orig-replacement [ipre #""])
|
||||
(define buf (if (and (string? string) (or (byte-regexp? pattern)
|
||||
(bytes? pattern)))
|
||||
(define buf
|
||||
(if (and (string? string)
|
||||
(or (byte-regexp? pattern) (bytes? pattern)))
|
||||
(string->bytes/utf-8 string (char->integer #\?))
|
||||
string))
|
||||
(define sub (if (bytes? buf) subbytes substring))
|
||||
(define start 0)
|
||||
(define end #f)
|
||||
(define needs-string?
|
||||
(and (or (string? pattern) (regexp? pattern))
|
||||
(string? string)))
|
||||
(and (or (string? pattern) (regexp? pattern)) (string? string)))
|
||||
(define replacement
|
||||
(if (and (not needs-string?) (string? orig-replacement))
|
||||
(string->bytes/utf-8 orig-replacement)
|
||||
orig-replacement))
|
||||
(define (check proc args)
|
||||
(let ([v (apply proc args)])
|
||||
(unless (if needs-string?
|
||||
(string? v)
|
||||
(bytes? v))
|
||||
(raise-mismatch-error '|regexp-replace* (calling given filter procedure)|
|
||||
(unless (if needs-string? (string? v) (bytes? v))
|
||||
(raise-mismatch-error
|
||||
'|regexp-replace* (calling given filter procedure)|
|
||||
(if needs-string?
|
||||
"expected a string result: "
|
||||
"expected a byte string result: ")
|
||||
v))
|
||||
v))
|
||||
(define need-replac? (and (not (procedure? replacement))
|
||||
(define need-replac?
|
||||
(and (not (procedure? replacement))
|
||||
(regexp-match? #rx#"[\\&]" replacement)))
|
||||
(define (replac ms str)
|
||||
(if need-replac?
|
||||
|
|
@ -345,22 +341,22 @@
|
|||
(apply
|
||||
bytes-append
|
||||
(let ([str (if (string? str) (string->bytes/utf-8 str) str)]
|
||||
[get-match (lambda (n)
|
||||
[get-match
|
||||
(lambda (n)
|
||||
(if (n . < . (length ms))
|
||||
(let* ([p (list-ref ms n)]
|
||||
[s (if (pair? p)
|
||||
(sub buf (car p) (cdr p))
|
||||
p)])
|
||||
(if (string? s)
|
||||
(string->bytes/utf-8 s)
|
||||
s))
|
||||
(if (string? s) (string->bytes/utf-8 s) s))
|
||||
#""))])
|
||||
(let loop ([pos 0])
|
||||
(let ([m (regexp-match-positions #rx#"[\\&]" str pos)])
|
||||
(if m
|
||||
(cons (subbytes str pos (caar m))
|
||||
(cond
|
||||
[(equal? (char->integer #\&) (bytes-ref str (caar m)))
|
||||
[(equal? (char->integer #\&)
|
||||
(bytes-ref str (caar m)))
|
||||
(cons (get-match 0) (loop (cdar m)))]
|
||||
[(= (cdar m) (bytes-length str))
|
||||
;; \ with no following character
|
||||
|
|
@ -373,10 +369,14 @@
|
|||
=> (lambda (s)
|
||||
(cons s (loop (add1 (cdar m)))))]
|
||||
[else
|
||||
(let ([n (regexp-match #rx#"^[0-9]+" str (cdar m))])
|
||||
(let ([n (regexp-match #rx#"^[0-9]+" str
|
||||
(cdar m))])
|
||||
(if n
|
||||
(cons (get-match (string->number (bytes->string/utf-8 (car n))))
|
||||
(loop (+ (cdar m) (bytes-length (car n)))))
|
||||
(cons (get-match (string->number
|
||||
(bytes->string/utf-8
|
||||
(car n))))
|
||||
(loop (+ (cdar m)
|
||||
(bytes-length (car n)))))
|
||||
(cons (get-match 0)
|
||||
(loop (cdar m)))))]))
|
||||
(list (subbytes str pos))))))))
|
||||
|
|
@ -385,22 +385,25 @@
|
|||
(regexp? pattern) (byte-regexp? pattern))
|
||||
(unless (or (string? string)
|
||||
(bytes? string))
|
||||
(raise-type-error 'regexp-replace* "string or byte string" string))
|
||||
(raise-type-error 'regexp-replace* "string or byte string"
|
||||
string))
|
||||
(unless (or (string? replacement)
|
||||
(bytes? replacement)
|
||||
(procedure? replacement))
|
||||
(raise-type-error 'regexp-replace* "string, byte string, or procedure"
|
||||
(raise-type-error 'regexp-replace*
|
||||
"string, byte string, or procedure"
|
||||
replacement))
|
||||
(when (and needs-string? (bytes? replacement))
|
||||
(raise-mismatch-error 'regexp-replace*
|
||||
(raise-mismatch-error
|
||||
'regexp-replace*
|
||||
"cannot replace a string with a byte string: "
|
||||
replacement)))
|
||||
(apply
|
||||
(if (bytes? buf) bytes-append string-append)
|
||||
(regexp-loop
|
||||
regexp-replace* loop start end pattern buf ipre
|
||||
(regexp-loop regexp-replace* loop start end pattern buf ipre
|
||||
;; success-choose:
|
||||
(lambda (start mstart mend ms acc) (list* (if (procedure? replacement)
|
||||
(lambda (start mstart mend ms acc)
|
||||
(list* (if (procedure? replacement)
|
||||
(check
|
||||
replacement
|
||||
(for/list ([m ms])
|
||||
|
|
@ -423,13 +426,14 @@
|
|||
|
||||
;; Returns all the matches for the pattern in the string.
|
||||
(define (regexp-match* pattern string [start 0] [end #f] [ipre #""])
|
||||
(define buf (if (and (string? string) (or (byte-regexp? pattern)
|
||||
(bytes? pattern)))
|
||||
(define buf
|
||||
(if (and (string? string) (or (byte-regexp? pattern) (bytes? pattern)))
|
||||
(string->bytes/utf-8 string (char->integer #\?))
|
||||
string))
|
||||
(define sub (if (or (bytes? buf) (and (path? string)
|
||||
(or (bytes? pattern)
|
||||
(byte-regexp? pattern))))
|
||||
(define sub
|
||||
(if (or (bytes? buf)
|
||||
(and (path? string)
|
||||
(or (bytes? pattern) (byte-regexp? pattern))))
|
||||
subbytes
|
||||
substring))
|
||||
(regexp-loop regexp-match* loop start end pattern buf ipre
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user