Changeset 12192 in project
- Timestamp:
- 10/18/08 15:33:16 (12 years ago)
- Location:
- chicken/branches/irregular
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/branches/irregular/irregex.scm
r12124 r12192 73 73 res)) 74 74 75 (define (irregex-match-num-submatches m) 76 (quotient (- (vector-length m) 3) 2)) 77 75 78 (define (irregex-match-string m) 76 79 (vector-ref m 1)) … … 80 83 (vector-set! m 1 str)) 81 84 82 (define ( %irregex-match-startm n)85 (define (irregex-match-start-index m n) 83 86 (vector-ref m (+ 3 (* n 2)))) 84 (define ( %irregex-match-endm n)87 (define (irregex-match-end-index m n) 85 88 (vector-ref m (+ 4 (* n 2)))) 86 89 87 (define ( %irregex-match-start-set! m n start)90 (define (irregex-match-start-index-set! m n start) 88 91 (vector-set! m (+ 3 (* n 2)) start)) 89 (define ( %irregex-match-end-set! m n end)92 (define (irregex-match-end-index-set! m n end) 90 93 (vector-set! m (+ 4 (* n 2)) end)) 91 94 92 (define ( %irregex-match-index m opt)95 (define (irregex-match-index m opt) 93 96 (if (pair? opt) 94 97 (cond ((number? (car opt)) (car opt)) … … 97 100 0)) 98 101 99 (define ( %irregex-match-valid-index? m n)102 (define (irregex-match-valid-index? m n) 100 103 (and (< (+ 3 (* n 2)) (vector-length m)) 101 104 (vector-ref m (+ 4 (* n 2))))) 102 105 103 106 (define (irregex-match-substring m . opt) 104 (let ((n ( %irregex-match-index m opt)))105 (and ( %irregex-match-valid-index? m n)107 (let ((n (irregex-match-index m opt))) 108 (and (irregex-match-valid-index? m n) 106 109 (substring (irregex-match-string m) 107 110 (vector-ref m (+ 3 (* n 2))) … … 109 112 110 113 (define (irregex-match-start m . opt) 111 (let ((n ( %irregex-match-index m opt)))112 (and ( %irregex-match-valid-index? m n)114 (let ((n (irregex-match-index m opt))) 115 (and (irregex-match-valid-index? m n) 113 116 (vector-ref m (+ 3 (* n 2)))))) 114 117 115 118 (define (irregex-match-end m . opt) 116 ( %irregex-match-valid-index? m (%irregex-match-index m opt)))119 (irregex-match-valid-index? m (irregex-match-index m opt))) 117 120 118 121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 1507 1510 (cond 1508 1511 (m-end 1509 ( %irregex-match-start-set! matches 0 start)1510 ( %irregex-match-end-set! matches 0 m-end)1512 (irregex-match-start-index-set! matches 0 start) 1513 (irregex-match-end-index-set! matches 0 m-end) 1511 1514 ((irregex-dfa/extract irx) str start m-end matches) 1512 1515 matches) … … 1529 1532 (cond 1530 1533 (m-end 1531 ( %irregex-match-start-set! matches 0 m-start)1532 ( %irregex-match-end-set! matches 0 m-end)1534 (irregex-match-start-index-set! matches 0 m-start) 1535 (irregex-match-end-index-set! matches 0 m-end) 1533 1536 ((irregex-dfa/extract irx) str m-start m-end matches) 1534 1537 matches) … … 1542 1545 (cond 1543 1546 (i 1544 ( %irregex-match-start-set! matches 0 start)1545 ( %irregex-match-end-set! matches 0 i)1547 (irregex-match-start-index-set! matches 0 start) 1548 (irregex-match-end-index-set! matches 0 i) 1546 1549 matches) 1547 1550 (else … … 1559 1562 (cond 1560 1563 ((equal? m-end end) 1561 ( %irregex-match-start-set! matches 0 start)1562 ( %irregex-match-end-set! matches 0 m-end)1564 (irregex-match-start-index-set! matches 0 start) 1565 (irregex-match-end-index-set! matches 0 m-end) 1563 1566 ((irregex-dfa/extract irx) str start m-end matches) 1564 1567 matches) … … 1570 1573 (cond 1571 1574 ((equal? i end) 1572 ( %irregex-match-start-set! matches 0 start)1573 ( %irregex-match-end-set! matches 0 i)1575 (irregex-match-start-index-set! matches 0 start) 1576 (irregex-match-end-index-set! matches 0 i) 1574 1577 matches) 1575 1578 (else … … 2114 2117 (cond 2115 2118 ((number? res) 2116 ( %irregex-match-start-set! matches n i)2117 ( %irregex-match-end-set! matches n res)))2119 (irregex-match-start-index-set! matches n i) 2120 (irregex-match-end-index-set! matches n res))) 2118 2121 res)))) 2119 2122 (else … … 2337 2340 (cadr sre)))) 2338 2341 (lambda (str i matches fail2) 2339 (if ( %irregex-match-endmatches index)2342 (if (irregex-match-end-index matches index) 2340 2343 (pass str i matches fail2) 2341 2344 (fail str i matches fail2))))) … … 2370 2373 flags 2371 2374 (lambda (str i matches fail) 2372 (let ((old ( %irregex-match-endmatches n)))2373 ( %irregex-match-end-set! matches n i)2375 (let ((old (irregex-match-end-index matches n))) 2376 (irregex-match-end-index-set! matches n i) 2374 2377 (next str i matches 2375 2378 (lambda () 2376 ( %irregex-match-end-set! matches n old)2379 (irregex-match-end-index-set! matches n old) 2377 2380 (fail)))))))) 2378 2381 (lambda (str i matches fail) 2379 (let ((old ( %irregex-match-startmatches n)))2380 ( %irregex-match-start-set! matches n i)2382 (let ((old (irregex-match-start-index matches n))) 2383 (irregex-match-start-index-set! matches n i) 2381 2384 (body str i matches 2382 2385 (lambda () 2383 ( %irregex-match-start-set! matches n old)2386 (irregex-match-start-index-set! matches n old) 2384 2387 (fail))))))) 2385 2388 ((submatch-named) -
chicken/branches/irregular/regex.scm
r12131 r12192 45 45 irregex-new-matches irregex-reset-matches! 46 46 irregex-match-start irregex-match-end irregex-match-substring 47 irregex-match-num-submatches 47 48 irregex-search irregex-search/matches irregex-match irregex-match-string 48 49 irregex-replace irregex-replace/all … … 73 74 (let ((opts '())) 74 75 (when caseless (set! opts (cons 'i opts))) 76 (when extended (set! opts (cons 'x opts))) 75 77 (when utf8 (set! opts (cons 'utf8 opts))) 76 78 opts))) ) … … 84 86 (let ((rx (unregexp rx))) 85 87 (and-let* ((m (irregex-match rx str))) 86 (let ((n (irregex-submatches rx))) 87 (cons 88 str 89 (let loop ((i 0)) 90 (if (fx>= i n) 91 '() 92 (cons (irregex-match-substring m i) (loop (fx+ i 1)))))))))) 88 (let loop ((i (irregex-match-num-submatches m)) 89 (res '())) 90 (if (fx<= i 0) 91 (cons str res) 92 (loop (fx- i 1) (cons (irregex-match-substring m i) res))))))) 93 93 94 94 (define (string-match-positions rx str) 95 95 (let ((rx (unregexp rx))) 96 96 (and-let* ((m (irregex-match rx str))) 97 (let ((n (irregex-submatches m))) 98 (cons 99 (list (%irregex-match-start m 0) 100 (%irregex-match-end m 0)) 101 (let loop ((i 0)) 102 (if (fx>= i n) 103 '() 104 (cons (list (irregex-match-start m i) 105 (irregex-match-end m i)) 106 (loop (fx+ i 1)))))))))) 97 (let loop ((i (irregex-match-num-submatches m)) 98 (res '())) 99 (if (fx<= i 0) 100 (cons (list 0 (string-length str)) res) 101 (loop (fx- i 1) (cons (list (irregex-match-start-index m i) 102 (irregex-match-end-index m i)) 103 res))))))) 107 104 108 105 (define (string-search rx str #!optional (start 0) (range (string-length str))) 109 106 (let ((rx (unregexp rx))) 110 107 (and-let* ((m (irregex-search rx str start (fx+ start range)))) 111 (let loop ((i (irregex-submatches rx)) 112 (res (list (irregex-match-string m)))) 113 (if (fx< i 0) 114 res 115 (loop (fx- i 1) 116 (cons (irregex-match-substring m i) res))))))) 108 (let loop ((i (irregex-match-num-submatches m)) 109 (res '())) 110 (if (fx< i 0) 111 res 112 (loop (fx- i 1) (cons (irregex-match-substring m i) res))))))) 117 113 118 114 (define (string-search-positions rx str #!optional (start 0) (range (string-length str))) 119 115 (let ((rx (unregexp rx))) 120 116 (and-let* ((m (irregex-search rx str start (fx+ start range)))) 121 (let loop ((i (irregex-submatches rx)) 122 (res (list (list (%irregex-match-start m 0) 123 (%irregex-match-end m 0))))) 124 (if (fx< i 0) 125 '() 126 (loop (fx- i 1) 127 (cons (list (irregex-match-start m i) 128 (irregex-match-end m i)) 129 res))))))) 117 (let loop ((i (irregex-match-num-submatches m)) 118 (res '())) 119 (if (fx< i 0) 120 res 121 (loop (fx- i 1) (cons (list (irregex-match-start-index m i) 122 (irregex-match-end-index m i)) 123 res))))))) 130 124 131 125
Note: See TracChangeset
for help on using the changeset viewer.