Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv642/src/builtin
Modified Files:
parser.wisp
Log Message:
Implemented the #/.../ regex syntax.
Index: parser.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/parser.wisp,v
retrieving revision 1.118
retrieving revision 1.119
diff -u -d -r1.118 -r1.119
--- parser.wisp 4 Sep 2002 14:38:13 -0000 1.118
+++ parser.wisp 4 Sep 2002 14:39:37 -0000 1.119
@@ -143,6 +143,9 @@
((or (eqv? d #\x) (eqv? d #\X))
(read-char port)
#\4)
+ ((eqv? d #\/) ; a regex
+ (read-char port)
+ (cons 'PARSED (read-external-string port #t)))
((char-letter? d)
(my name (string->symbol
(string-downcase
@@ -192,7 +195,7 @@
(if (eof-object? d)
"#"
"#$,[d]")))))))))
- ((#\") `(PARSED . ,(read-external-string port)))
+ ((#\") `(PARSED . ,(read-external-string port #f)))
((#\( #\) #\[ #\]) c)
(else
`(invalid-char . ,c)))))))))
@@ -320,14 +323,18 @@
(define (read (port *stdin*))
(read-complex-structure port))
- (define (read-until-dollar port)
+ (define (read-until-dollar port is-regex?)
(let* ((term #f)
(body (collect-string
(lambda (emit)
(let (loop)
(case (read-char port) c
- ((#\")
- (set! term #f))
+ ((#\" #\/)
+ (if (eqv? c (if is-regex? #\/ #\"))
+ (set! term #f)
+ (begin
+ (emit c)
+ (loop))))
((#\$)
(case (peek-char port)
((#\$ #\, #\open #\[)
@@ -376,43 +383,19 @@
(cond
((eof-object? e)
(raise 'EOF-INSIDE-STRING #f))
- ((and (char<=? #\0 e #\3))
- (integer->char
- (string->integer
- (my ee (peek-char port)
- (if (and (char? ee)
- (char<=? #\0 ee #\7))
- (begin
- (read-char port)
- (my eee (peek-char port)
- (if (and (char? eee)
- (char<=? #\0 eee #\7))
- (begin
- (read-char port)
- (string e ee eee))
- (string e ee))))
- (string e)))
- 8)))
- ((and (char<=? #\4 e #\7))
- (integer->char
- (string->integer
- (my ee (peek-char port)
- (if (and (char? ee)
- (char<=? #\0 ee #\7))
- (begin
- (read-char port)
- (string e ee))
- (string e)))
- 8)))
- (else e)))))
+ (else ; other escapes ...
+ (if is-regex?
+ ; get their backslash in regexen
+ (string c e)
+ e))))))
(else c)))
(loop))))))))
(cons body term)))
- (define (read-external-string port)
+ (define (read-external-string port is-regex?)
(my tail '()
(let (loop)
- (my p (read-until-dollar port)
+ (my p (read-until-dollar port is-regex?)
(if (cdr p)
(begin
(my s (car p)
@@ -441,15 +424,20 @@
(set! item (list 'begin item)))
(cons! tail item)))
(loop))
- (if (null? tail)
- (car p)
- (begin
- (my s (car p)
- (if (not (string-null? s))
- (cons! tail s)))
- (if (and (null? (cdr tail)) (string? (car tail)))
- (car tail)
- (cons 'string-template (reverse tail)))))))))))
+ (begin
+ (my s (car p)
+ (if (not (string-null? s))
+ (cons! tail s)))
+ (if (null? tail)
+ (set! tail (list (string))))
+ (if (and (null? (cdr tail)) (string? (car tail)))
+ (if is-regex?
+ (cons 'regex tail)
+ (car tail))
+ (cons (if is-regex?
+ 'regex-template
+ 'string-template)
+ (reverse tail))))))))))
(defmacro (string-template . items)
(if (null? items)
|
