Update of /cvsroot/scsh/scsh/scsh/rx
In directory usw-pr-cvs1:/tmp/cvs-serv11197/scsh/rx
Modified Files:
Tag: srfi13and14_integration_2000_3_10
packages.scm parse.scm posixstr.scm re.scm rx-lib.scm simp.scm
spencer.scm
Log Message:
Integrated srfi-13 (string lib)& srfi-14 (char-set lib)
- Ported sources to use these libs instead of older string & cset libs
- Wrote backwards-compatibility libs for now-deprecated procs in the
scsh API
- Hacked the makefile/package/interfaces glue
Whew.
Index: packages.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/packages.scm,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -C2 -r1.4 -r1.4.2.1
*** packages.scm 2000/02/15 15:49:13 1.4
--- packages.scm 2001/03/11 03:47:00 1.4.2.1
***************
*** 199,203 ****
defrec-package
receiving
! char-set-package
error-package
ascii
--- 199,203 ----
defrec-package
receiving
! char-set-lib
error-package
ascii
***************
*** 235,239 ****
conditionals
re-level-0
! char-set-package
scsh-utilities ; fold
error-package
--- 235,239 ----
conditionals
re-level-0
! char-set-lib
scsh-utilities ; fold
error-package
***************
*** 250,254 ****
(define-structure rx-syntax rx-syntax-interface
(open re-level-0
! char-set-package
rx-lib
scheme)
--- 250,254 ----
(define-structure rx-syntax rx-syntax-interface
(open re-level-0
! char-set-lib
rx-lib
scheme)
Index: parse.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/parse.scm,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -C2 -r1.3 -r1.3.2.1
*** parse.scm 1999/09/08 15:21:39 1.3
--- parse.scm 2001/03/11 03:47:00 1.3.2.1
***************
*** 75,80 ****
;;; Two useful standard char sets
! (define nonl-chars (char-set-invert (char-set #\newline)))
! (define word-chars (char-set-union (char-set #\_) char-set:alphanumeric))
;;; Little utility that should be moved to scsh's utilities.scm
--- 75,80 ----
;;; Two useful standard char sets
! (define nonl-chars (char-set-complement (char-set #\newline)))
! (define word-chars (char-set-union (char-set #\_) char-set:letter+digit))
;;; Little utility that should be moved to scsh's utilities.scm
***************
*** 233,238 ****
r))
(cs (if (char-set? cs)
! (char-set-invert cs)
! `(,(r 'char-set-invert) ,cs))))
(if cset? cs (make-re-char-set cs))))
--- 233,238 ----
r))
(cs (if (char-set? cs)
! (char-set-complement cs)
! `(,(r 'char-set-complement) ,cs))))
(if cset? cs (make-re-char-set cs))))
***************
*** 282,288 ****
((lower-case lower) char-set:lower-case)
((upper-case upper) char-set:upper-case)
! ((alphabetic alpha) char-set:alphabetic)
! ((numeric digit num) char-set:numeric)
! ((alphanumeric alnum alphanum) char-set:alphanumeric)
((punctuation punct) char-set:punctuation)
((graphic graph) char-set:graphic)
--- 282,288 ----
((lower-case lower) char-set:lower-case)
((upper-case upper) char-set:upper-case)
! ((alphabetic alpha) char-set:letter)
! ((numeric digit num) char-set:digit)
! ((alphanumeric alnum alphanum) char-set:letter+digit)
((punctuation punct) char-set:punctuation)
((graphic graph) char-set:graphic)
***************
*** 290,294 ****
((whitespace space white) char-set:whitespace)
((printing print) char-set:printing)
! ((control cntrl) char-set:control)
((hex-digit xdigit hex) char-set:hex-digit)
((ascii) char-set:ascii)
--- 290,294 ----
((whitespace space white) char-set:whitespace)
((printing print) char-set:printing)
! ((control cntrl) char-set:iso-control)
((hex-digit xdigit hex) char-set:hex-digit)
((ascii) char-set:ascii)
***************
*** 347,354 ****
(if cs? cset (uncase-char-set cset)) ; Case fold if necessary.
(lp (- i 2)
! (char-set-union!
! cset
! (ascii-range->char-set (char->ascii (string-ref specs (-
i 1)))
! (+ 1 (char->ascii (string-ref
specs i)))))))))))
;;; (regexp->scheme re r)
--- 347,353 ----
(if cs? cset (uncase-char-set cset)) ; Case fold if necessary.
(lp (- i 2)
! (ucs-range->char-set! (char->ascii (string-ref specs (- i 1)))
! (+ 1 (char->ascii (string-ref specs i)))
! #f cset)))))))
;;; (regexp->scheme re r)
***************
*** 452,460 ****
(if one
(switch char-set= cs
! ((char-set:alphanumeric) alphanum)
((char-set:graphic) graph)
((char-set:hex-digit) hex)
(else #f))
! (and (char-set= cs char-set:alphabetic) alpha)))
(and (char-set= cs char-set:lower-case) lower)) ; a, not A
--- 451,459 ----
(if one
(switch char-set= cs
! ((char-set:letter+digit) alphanum)
((char-set:graphic) graph)
((char-set:hex-digit) hex)
(else #f))
! (and (char-set= cs char-set:letter) alpha)))
(and (char-set= cs char-set:lower-case) lower)) ; a, not A
***************
*** 462,466 ****
(and (not space) (char-set= cs char-set:upper-case) upper)
(if one
! (and (not space) (char-set= cs char-set:numeric) num)
(if space
(switch char-set= cs
--- 461,465 ----
(and (not space) (char-set= cs char-set:upper-case) upper)
(if one
! (and (not space) (char-set= cs char-set:digit) num)
(if space
(switch char-set= cs
***************
*** 470,474 ****
(switch char-set= cs
((char-set:punctuation) punct)
! ((char-set:control) ctl)
(else #f))))))))
--- 469,473 ----
(switch char-set= cs
((char-set:punctuation) punct)
! ((char-set:iso-control) ctl)
(else #f))))))))
***************
*** 479,486 ****
'char-set:full 'nonl-chars
'char-set:lower-case
'char-set:upper-case
! 'char-set:alphabetic 'char-set:numeric
! 'char-set:alphanumeric
'char-set:punctuation
'char-set:graphic
'char-set:whitespace
! 'char-set:printing 'char-set:control
'char-set:hex-digit 'char-set:blank
'char-set:ascii))))
--- 478,485 ----
'char-set:full 'nonl-chars
'char-set:lower-case
'char-set:upper-case
! 'char-set:letter 'char-set:digit
! 'char-set:letter+digit
'char-set:punctuation
'char-set:graphic
'char-set:whitespace
! 'char-set:printing
'char-set:iso-control
'char-set:hex-digit 'char-set:blank
'char-set:ascii))))
***************
*** 488,497 ****
((char-set-empty? cs) (r 'char-set:empty))
((try cs) => r)
! ((try (char-set-invert cs)) =>
! (lambda (name) `(,(r 'char-set-invert) ,name)))
(else
(receive (loose+ ranges+) (char-set->in-pair cs)
! (receive (loose- ranges-) (char-set->in-pair (char-set-invert cs))
(let ((makeit (r 'spec->char-set)))
(if (< (+ (length loose-) (* 12 (length ranges-)))
--- 487,496 ----
((char-set-empty? cs) (r 'char-set:empty))
((try cs) => r)
! ((try (char-set-complement cs)) =>
! (lambda (name) `(,(r 'char-set-complement) ,name)))
(else
(receive (loose+ ranges+) (char-set->in-pair cs)
! (receive (loose- ranges-) (char-set->in-pair (char-set-complement cs))
(let ((makeit (r 'spec->char-set)))
(if (< (+ (length loose-) (* 12 (length ranges-)))
***************
*** 518,524 ****
(nchars (char-set-size cs)))
(? ((zero? nchars) `(,(r '|)))
! ((= 1 nchars) (apply string (char-set-members cs)))
((try cs) => r)
! ((try (char-set-invert cs)) =>
(lambda (name) `(,(r '~) ,name)))
(else (receive (cs rp comp?) (char-set->in-sexp-spec cs)
--- 517,523 ----
(nchars (char-set-size cs)))
(? ((zero? nchars) `(,(r '|)))
! ((= 1 nchars) (apply string (char-set->list cs)))
((try cs) => r)
! ((try (char-set-complement cs)) =>
(lambda (name) `(,(r '~) ,name)))
(else (receive (cs rp comp?) (char-set->in-sexp-spec cs)
***************
*** 620,624 ****
'() ranges)))))))
(receive (cs+ rp+) (->sexp-pair cset)
! (receive (cs- rp-) (->sexp-pair (char-set-invert cset))
(if (< (+ (string-length cs-) (string-length rp-))
(+ (string-length cs+) (string-length rp+)))
--- 619,623 ----
'() ranges)))))))
(receive (cs+ rp+) (->sexp-pair cset)
! (receive (cs- rp-) (->sexp-pair (char-set-complement cset))
(if (< (+ (string-length cs-) (string-length rp-))
(+ (string-length cs+) (string-length rp+)))
Index: posixstr.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/posixstr.scm,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -C2 -r1.4 -r1.4.2.1
*** posixstr.scm 1999/10/01 12:48:27 1.4
--- posixstr.scm 2001/03/11 03:47:00 1.4.2.1
***************
*** 376,384 ****
((= 1 nchars) ; Singleton set
! (translate-string (string (car (char-set-members cset)))))
;; General case. Try both [...] and [^...].
(else (let ((s- (->bracket-string cset #t))
! (s+ (->bracket-string (char-set-invert cset) #f)))
(values (if (< (string-length s-) (string-length s+))
s- s+)
--- 376,384 ----
((= 1 nchars) ; Singleton set
! (translate-string (string (car (char-set->list cset)))))
;; General case. Try both [...] and [^...].
(else (let ((s- (->bracket-string cset #t))
! (s+ (->bracket-string (char-set-complement cset) #f)))
(values (if (< (string-length s-) (string-length s+))
s- s+)
Index: re.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/re.scm,v
retrieving revision 1.5
retrieving revision 1.5.2.1
diff -C2 -r1.5 -r1.5.2.1
*** re.scm 2001/03/07 16:40:02 1.5
--- re.scm 2001/03/11 03:47:00 1.5.2.1
***************
*** 163,167 ****
res))))
(if (= 1 (char-set-size cset))
! (make-re-string (apply string (char-set-members cset)))
(make-re-char-set cset)))
--- 163,167 ----
res))))
(if (= 1 (char-set-size cset))
! (make-re-string (apply string (char-set->list cset)))
(make-re-char-set cset)))
***************
*** 388,392 ****
(define re-nonl
! (make-re-char-set/posix (char-set-invert (char-set #\newline))
"[^\n]"
'#()))
--- 388,392 ----
(define re-nonl
! (make-re-char-set/posix (char-set-complement (char-set #\newline))
"[^\n]"
'#()))
***************
*** 415,419 ****
(define re-word
! (let ((wcs (char-set-union char-set:alphanumeric ; Word chars
(char-set #\_))))
(make-re-seq (list re-bow
--- 415,419 ----
(define re-word
! (let ((wcs (char-set-union char-set:letter+digit ; Word chars
(char-set #\_))))
(make-re-seq (list re-bow
Index: rx-lib.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/rx-lib.scm,v
retrieving revision 1.2
retrieving revision 1.2.2.1
diff -C2 -r1.2 -r1.2.2.1
*** rx-lib.scm 1999/07/11 20:41:27 1.2
--- rx-lib.scm 2001/03/11 03:47:00 1.2.2.1
***************
*** 37,40 ****
(if in?
(doit loose ranges)
! (char-set-invert! (doit loose ranges)))))
--- 37,40 ----
(if in?
(doit loose ranges)
! (char-set-complement! (doit loose ranges)))))
Index: simp.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/simp.scm,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -C2 -r1.3 -r1.3.2.1
*** simp.scm 1999/09/08 15:21:40 1.3
--- simp.scm 2001/03/11 03:47:00 1.3.2.1
***************
*** 48,52 ****
(if (and (char-set? cs)
(= 1 (char-set-size cs)))
! (make-re-string (string (car (char-set-members cs))))
re))
0))
--- 48,52 ----
(if (and (char-set? cs)
(= 1 (char-set-size cs)))
! (make-re-string (string (car (char-set->list cs))))
re))
0))
***************
*** 244,248 ****
(tail (? ((zero? numchars) tail) ; Drop empty char set.
((= 1 numchars) ; {c} => "c"
! (cons (make-re-string (string (car (char-set-members cset))))
tail))
(else (cons (make-re-char-set cset) tail)))))
--- 244,248 ----
(tail (? ((zero? numchars) tail) ; Drop empty char set.
((= 1 numchars) ; {c} => "c"
! (cons (make-re-string (string (car (char-set->list cset))))
tail))
(else (cons (make-re-char-set cset) tail)))))
Index: spencer.scm
===================================================================
RCS file: /cvsroot/scsh/scsh/scsh/rx/spencer.scm,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -C2 -r1.3 -r1.3.2.1
*** spencer.scm 1999/09/30 18:33:35 1.3
--- spencer.scm 2001/03/11 03:47:00 1.3.2.1
***************
*** 129,133 ****
(lp i1 (char-set-adjoin! cset #\]))
(let ((cset (if negate?
! (char-set-invert! cset)
cset)))
(values (make-re-char-set cset) i1))))
--- 129,133 ----
(lp i1 (char-set-adjoin! cset #\]))
(let ((cset (if negate?
! (char-set-complement! cset)
cset)))
(values (make-re-char-set cset) i1))))
|