 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 (irregexmatchnumsubmatches m) 76 (quotient ( (vectorlength m) 3) 2)) 77 75 78 (define (irregexmatchstring m) 76 79 (vectorref m 1)) … … 80 83 (vectorset! m 1 str)) 81 84 82 (define ( %irregexmatchstartm n)85 (define (irregexmatchstartindex m n) 83 86 (vectorref m (+ 3 (* n 2)))) 84 (define ( %irregexmatchendm n)87 (define (irregexmatchendindex m n) 85 88 (vectorref m (+ 4 (* n 2)))) 86 89 87 (define ( %irregexmatchstartset! m n start)90 (define (irregexmatchstartindexset! m n start) 88 91 (vectorset! m (+ 3 (* n 2)) start)) 89 (define ( %irregexmatchendset! m n end)92 (define (irregexmatchendindexset! m n end) 90 93 (vectorset! m (+ 4 (* n 2)) end)) 91 94 92 (define ( %irregexmatchindex m opt)95 (define (irregexmatchindex m opt) 93 96 (if (pair? opt) 94 97 (cond ((number? (car opt)) (car opt)) … … 97 100 0)) 98 101 99 (define ( %irregexmatchvalidindex? m n)102 (define (irregexmatchvalidindex? m n) 100 103 (and (< (+ 3 (* n 2)) (vectorlength m)) 101 104 (vectorref m (+ 4 (* n 2))))) 102 105 103 106 (define (irregexmatchsubstring m . opt) 104 (let ((n ( %irregexmatchindex m opt)))105 (and ( %irregexmatchvalidindex? m n)107 (let ((n (irregexmatchindex m opt))) 108 (and (irregexmatchvalidindex? m n) 106 109 (substring (irregexmatchstring m) 107 110 (vectorref m (+ 3 (* n 2))) … … 109 112 110 113 (define (irregexmatchstart m . opt) 111 (let ((n ( %irregexmatchindex m opt)))112 (and ( %irregexmatchvalidindex? m n)114 (let ((n (irregexmatchindex m opt))) 115 (and (irregexmatchvalidindex? m n) 113 116 (vectorref m (+ 3 (* n 2)))))) 114 117 115 118 (define (irregexmatchend m . opt) 116 ( %irregexmatchvalidindex? m (%irregexmatchindex m opt)))119 (irregexmatchvalidindex? m (irregexmatchindex m opt))) 117 120 118 121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 1507 1510 (cond 1508 1511 (mend 1509 ( %irregexmatchstartset! matches 0 start)1510 ( %irregexmatchendset! matches 0 mend)1512 (irregexmatchstartindexset! matches 0 start) 1513 (irregexmatchendindexset! matches 0 mend) 1511 1514 ((irregexdfa/extract irx) str start mend matches) 1512 1515 matches) … … 1529 1532 (cond 1530 1533 (mend 1531 ( %irregexmatchstartset! matches 0 mstart)1532 ( %irregexmatchendset! matches 0 mend)1534 (irregexmatchstartindexset! matches 0 mstart) 1535 (irregexmatchendindexset! matches 0 mend) 1533 1536 ((irregexdfa/extract irx) str mstart mend matches) 1534 1537 matches) … … 1542 1545 (cond 1543 1546 (i 1544 ( %irregexmatchstartset! matches 0 start)1545 ( %irregexmatchendset! matches 0 i)1547 (irregexmatchstartindexset! matches 0 start) 1548 (irregexmatchendindexset! matches 0 i) 1546 1549 matches) 1547 1550 (else … … 1559 1562 (cond 1560 1563 ((equal? mend end) 1561 ( %irregexmatchstartset! matches 0 start)1562 ( %irregexmatchendset! matches 0 mend)1564 (irregexmatchstartindexset! matches 0 start) 1565 (irregexmatchendindexset! matches 0 mend) 1563 1566 ((irregexdfa/extract irx) str start mend matches) 1564 1567 matches) … … 1570 1573 (cond 1571 1574 ((equal? i end) 1572 ( %irregexmatchstartset! matches 0 start)1573 ( %irregexmatchendset! matches 0 i)1575 (irregexmatchstartindexset! matches 0 start) 1576 (irregexmatchendindexset! matches 0 i) 1574 1577 matches) 1575 1578 (else … … 2114 2117 (cond 2115 2118 ((number? res) 2116 ( %irregexmatchstartset! matches n i)2117 ( %irregexmatchendset! matches n res)))2119 (irregexmatchstartindexset! matches n i) 2120 (irregexmatchendindexset! matches n res))) 2118 2121 res)))) 2119 2122 (else … … 2337 2340 (cadr sre)))) 2338 2341 (lambda (str i matches fail2) 2339 (if ( %irregexmatchendmatches index)2342 (if (irregexmatchendindex 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 ( %irregexmatchendmatches n)))2373 ( %irregexmatchendset! matches n i)2375 (let ((old (irregexmatchendindex matches n))) 2376 (irregexmatchendindexset! matches n i) 2374 2377 (next str i matches 2375 2378 (lambda () 2376 ( %irregexmatchendset! matches n old)2379 (irregexmatchendindexset! matches n old) 2377 2380 (fail)))))))) 2378 2381 (lambda (str i matches fail) 2379 (let ((old ( %irregexmatchstartmatches n)))2380 ( %irregexmatchstartset! matches n i)2382 (let ((old (irregexmatchstartindex matches n))) 2383 (irregexmatchstartindexset! matches n i) 2381 2384 (body str i matches 2382 2385 (lambda () 2383 ( %irregexmatchstartset! matches n old)2386 (irregexmatchstartindexset! matches n old) 2384 2387 (fail))))))) 2385 2388 ((submatchnamed) 
chicken/branches/irregular/regex.scm
r12131 r12192 45 45 irregexnewmatches irregexresetmatches! 46 46 irregexmatchstart irregexmatchend irregexmatchsubstring 47 irregexmatchnumsubmatches 47 48 irregexsearch irregexsearch/matches irregexmatch irregexmatchstring 48 49 irregexreplace irregexreplace/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 (andlet* ((m (irregexmatch rx str))) 86 (let ((n (irregexsubmatches rx))) 87 (cons 88 str 89 (let loop ((i 0)) 90 (if (fx>= i n) 91 '() 92 (cons (irregexmatchsubstring m i) (loop (fx+ i 1)))))))))) 88 (let loop ((i (irregexmatchnumsubmatches m)) 89 (res '())) 90 (if (fx<= i 0) 91 (cons str res) 92 (loop (fx i 1) (cons (irregexmatchsubstring m i) res))))))) 93 93 94 94 (define (stringmatchpositions rx str) 95 95 (let ((rx (unregexp rx))) 96 96 (andlet* ((m (irregexmatch rx str))) 97 (let ((n (irregexsubmatches m))) 98 (cons 99 (list (%irregexmatchstart m 0) 100 (%irregexmatchend m 0)) 101 (let loop ((i 0)) 102 (if (fx>= i n) 103 '() 104 (cons (list (irregexmatchstart m i) 105 (irregexmatchend m i)) 106 (loop (fx+ i 1)))))))))) 97 (let loop ((i (irregexmatchnumsubmatches m)) 98 (res '())) 99 (if (fx<= i 0) 100 (cons (list 0 (stringlength str)) res) 101 (loop (fx i 1) (cons (list (irregexmatchstartindex m i) 102 (irregexmatchendindex m i)) 103 res))))))) 107 104 108 105 (define (stringsearch rx str #!optional (start 0) (range (stringlength str))) 109 106 (let ((rx (unregexp rx))) 110 107 (andlet* ((m (irregexsearch rx str start (fx+ start range)))) 111 (let loop ((i (irregexsubmatches rx)) 112 (res (list (irregexmatchstring m)))) 113 (if (fx< i 0) 114 res 115 (loop (fx i 1) 116 (cons (irregexmatchsubstring m i) res))))))) 108 (let loop ((i (irregexmatchnumsubmatches m)) 109 (res '())) 110 (if (fx< i 0) 111 res 112 (loop (fx i 1) (cons (irregexmatchsubstring m i) res))))))) 117 113 118 114 (define (stringsearchpositions rx str #!optional (start 0) (range (stringlength str))) 119 115 (let ((rx (unregexp rx))) 120 116 (andlet* ((m (irregexsearch rx str start (fx+ start range)))) 121 (let loop ((i (irregexsubmatches rx)) 122 (res (list (list (%irregexmatchstart m 0) 123 (%irregexmatchend m 0))))) 124 (if (fx< i 0) 125 '() 126 (loop (fx i 1) 127 (cons (list (irregexmatchstart m i) 128 (irregexmatchend m i)) 129 res))))))) 117 (let loop ((i (irregexmatchnumsubmatches m)) 118 (res '())) 119 (if (fx< i 0) 120 res 121 (loop (fx i 1) (cons (list (irregexmatchstartindex m i) 122 (irregexmatchendindex m i)) 123 res))))))) 130 124 131 125
Note: See TracChangeset
for help on using the changeset viewer.