.
original commit: 67abdf44f6bdbe08726174787e50ebb5eef2cf27
This commit is contained in:
parent
6695ee87f5
commit
fa470cf8f7
|
@ -27,6 +27,7 @@
|
|||
nand
|
||||
let+
|
||||
|
||||
namespace-defined?
|
||||
this-expression-source-directory
|
||||
define-syntax-set)
|
||||
|
||||
|
@ -423,6 +424,13 @@
|
|||
[(_ expr0 expr ...)
|
||||
(syntax (begin expr0 expr ... rest))])))))])))
|
||||
|
||||
(define (namespace-defined? n)
|
||||
(unless (symbol? n)
|
||||
(raise-type-error 'namespace-defined? "symbol" n))
|
||||
(with-handlers ([exn:variable? (lambda (x) #f)])
|
||||
(namespace-variable-binding n)
|
||||
#t))
|
||||
|
||||
(define-syntax (this-expression-source-directory stx)
|
||||
(syntax-case stx ()
|
||||
[(_)
|
||||
|
|
|
@ -6,9 +6,8 @@
|
|||
read-from-string
|
||||
read-from-string-all
|
||||
expr->string
|
||||
newline-string
|
||||
string->literal-regexp-string
|
||||
string->literal-replace-string
|
||||
regexp-quote
|
||||
regexp-replace-quote
|
||||
regexp-match-exact?)
|
||||
|
||||
(require (lib "etc.ss"))
|
||||
|
@ -107,10 +106,10 @@
|
|||
(write v port)
|
||||
s)))
|
||||
|
||||
(define newline-string (string #\newline))
|
||||
|
||||
(define string->literal-regexp-string
|
||||
(define regexp-quote
|
||||
(opt-lambda (s [case-sens? #t])
|
||||
(unless (string? s)
|
||||
(raise-type-error 'regexp-quote "string" s))
|
||||
(list->string
|
||||
(apply
|
||||
append
|
||||
|
@ -125,11 +124,14 @@
|
|||
[else (list c)]))
|
||||
(string->list s))))))
|
||||
|
||||
(define (string->literal-replace-string s)
|
||||
(define (regexp-replace-quote s)
|
||||
(unless (string? s)
|
||||
(raise-type-error 'regexp-replace-quote "string" s))
|
||||
(regexp-replace* "\\\\" s "\\\\\\\\"))
|
||||
|
||||
(define regexp-match-exact?
|
||||
(lambda (p s)
|
||||
(let ([m (regexp-match p s)])
|
||||
(let ([m (regexp-match-positions p s)])
|
||||
(and m
|
||||
(string=? (car m) s))))))
|
||||
(zero? (caar m))
|
||||
(= (string-length s) (cdar m)))))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user