suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use regexp-match?, fix a defclass bug

Browse Source 
svn: r5207
This commit is contained in:
Eli Barzilay 2007-01-03 08:14:07 +00:00
parent 41cb5beb36
commit 8305afe8d5
4 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/swindle/extra.ss
View File

@ -8,7 +8,7 @@
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; A convenient `defstruct' ;;; A convenient `defstruct'
;; This makes it possible to create MzScheme structs using Swindle's `main' and ;; This makes it possible to create MzScheme structs using Swindle's `make' and
;; keyword arguments. ;; keyword arguments.
(define struct-to-slot-names (make-hash-table)) (define struct-to-slot-names (make-hash-table))
@ -36,8 +36,9 @@
[keys (build-list [keys (build-list
(length slots) (length slots)
(lambda (n) (list (symbol-append ': (nth slots n)) n)))] (lambda (n) (list (symbol-append ': (nth slots n)) n)))]
[setter! (4th (call-with-values [setter! (5th (call-with-values
(thunk (struct-type-info stype)) list))]) (thunk (struct-type-info stype))
list))])
(method ([obj this] initargs) (method ([obj this] initargs)
(for-each (lambda (k) (for-each (lambda (k)
(let ([v (getarg initargs (1st k) none)]) (let ([v (getarg initargs (1st k) none)])
@ -93,7 +94,8 @@
(defsyntax* (defstruct stx) (defsyntax* (defstruct stx)
(define <>-re #rx"^<(.*)>$") (define <>-re #rx"^<(.*)>$")
(define (<>-id? id) (define (<>-id? id)
(and (identifier? id) (regexp-match <>-re (symbol->string (syntax-e id))))) (and (identifier? id)
(regexp-match? <>-re (symbol->string (syntax-e id)))))
(define (doit name super slots) (define (doit name super slots)
(let* ([str (regexp-replace <>-re (symbol->string (syntax-e name)) "\\1")] (let* ([str (regexp-replace <>-re (symbol->string (syntax-e name)) "\\1")]
[name-sans-<> (datum->syntax-object name (string->symbol str) name)] [name-sans-<> (datum->syntax-object name (string->symbol str) name)]

10
collects/swindle/html.ss
View File

@ -132,11 +132,11 @@
(define* (relativize-path path) (define* (relativize-path path)
(if (and (string? path) ; hack -- non-strings are just ignored (if (and (string? path) ; hack -- non-strings are just ignored
(not (regexp-match #rx"^[a-z]+://" path))) (not (regexp-match? #rx"^[a-z]+://" path)))
(let ([cur-path (let ([cur-path
(cond [(*current-html-obj*) => (lambda (x) (getarg x :name))] (cond [(*current-html-obj*) => (lambda (x) (getarg x :name))]
[else #f])]) [else #f])])
(if (and cur-path (regexp-match #rx"/" cur-path)) (if (and cur-path (regexp-match? #rx"/" cur-path))
(let loop ([path path] [cur-path cur-path]) (let loop ([path path] [cur-path cur-path])
(let ([x (regexp-match #rx"^([^/]*/)(.*)" path)]) (let ([x (regexp-match #rx"^([^/]*/)(.*)" path)])
(if (and x (>= (string-length cur-path) (string-length (cadr x))) (if (and x (>= (string-length cur-path) (string-length (cadr x)))
@ -251,7 +251,7 @@
(substring str (caaddr x) (cdaddr x)))]) (substring str (caaddr x) (cdaddr x)))])
(when (or scm? (when (or scm?
(not split-lines?) (not split-lines?)
(not (regexp-match #rx"^ *$" prefix))) (not (regexp-match? #rx"^ *$" prefix)))
(disp prefix)) (disp prefix))
(cond (cond
[(and (not scm?) token2 [(and (not scm?) token2
@ -275,7 +275,7 @@
[(equal? token meta-begin) (open) [(equal? token meta-begin) (open)
(loop suffix)] (loop suffix)]
[(equal? token meta-end) (close) [(equal? token meta-end) (close)
(loop (if (and split-lines? (regexp-match #rx"^ *$" suffix)) (loop (if (and split-lines? (regexp-match? #rx"^ *$" suffix))
(begin (set! split-indent #f) (read-line)) (begin (set! split-indent #f) (read-line))
suffix))] suffix))]
;; remove one "\" (never happens -- see comment above) ;; remove one "\" (never happens -- see comment above)
@ -315,7 +315,7 @@
(define re (if (regexp? (car x)) (car x) (regexp (car x)))) (define re (if (regexp? (car x)) (car x) (regexp (car x))))
(cons re (cons re
(if (and (string? (cadr x)) (if (and (string? (cadr x))
(regexp-match #rx"\\\\[0-9]" (cadr x))) (regexp-match? #rx"\\\\[0-9]" (cadr x)))
(lambda (str . rest) (lambda (str . rest)
(if (string? str) (if (string? str)
(regexp-replace re str (cadr x)) (regexp-replace re str (cadr x))

2
collects/swindle/tiny-clos.ss
View File

@ -1822,7 +1822,7 @@
method method
(let* ([psym (object-name (%method-procedure method))] (let* ([psym (object-name (%method-procedure method))]
[pstr (and psym (symbol->string psym))]) [pstr (and psym (symbol->string psym))])
(if (or (not pstr) (regexp-match #rx":[0-9]*:[0-9]*$" pstr)) (if (or (not pstr) (regexp-match? #rx":[0-9]*:[0-9]*$" pstr))
(compute-method-name (%method-specializers method) (compute-method-name (%method-specializers method)
(%generic-name generic)) (%generic-name generic))
psym))))) psym)))))

4
collects/swindle/tool.ss
View File

@ -130,11 +130,11 @@
(parameterize ([current-directory (collection-path "swindle")]) (parameterize ([current-directory (collection-path "swindle")])
(define counter 100) (define counter 100)
(define (do-customize file) (define (do-customize file)
(when (regexp-match #rx"\\.ss$" file) (when (regexp-match? #rx"\\.ss$" file)
(with-input-from-file file (with-input-from-file file
(lambda () (lambda ()
(let ([l (read-line)]) (let ([l (read-line)])
(when (regexp-match #rx"^;+ *CustomSwindle *$" l) (when (regexp-match? #rx"^;+ *CustomSwindle *$" l)
(let ([file (regexp-replace #rx"\\.ss$" file "")] (let ([file (regexp-replace #rx"\\.ss$" file "")]
[name #f] [dname #f] [one-line #f] [url #f]) [name #f] [dname #f] [one-line #f] [url #f])
(let loop ([l (read-line)]) (let loop ([l (read-line)])