pcre: using private to hide implementation details.
parent
c81d1dc71f
commit
239349f84b
|
@ -1,9 +0,0 @@
|
||||||
USING: accessors pcre pcre.info pcre.utils sequences tools.test ;
|
|
||||||
|
|
||||||
[ { { 3 "day" } { 2 "month" } { 1 "year" } } ]
|
|
||||||
[
|
|
||||||
"(?P<year>\\d{4})-(?P<month>\\d{2})-(?P<day>\\d{2})" <compiled-pcre>
|
|
||||||
nametable>>
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ { 100 110 120 130 } ] [ 100 10 4 gen-array-addrs ] unit-test
|
|
|
@ -1,36 +0,0 @@
|
||||||
USING:
|
|
||||||
accessors
|
|
||||||
alien alien.accessors alien.c-types alien.data alien.strings
|
|
||||||
arrays
|
|
||||||
io.encodings.utf8
|
|
||||||
kernel
|
|
||||||
math math.bitwise
|
|
||||||
pcre.ffi pcre.utils
|
|
||||||
sequences ;
|
|
||||||
IN: pcre.info
|
|
||||||
|
|
||||||
! Mostly internal
|
|
||||||
: fullinfo ( pcre extra what -- obj )
|
|
||||||
{ int } [ pcre_fullinfo ] with-out-parameters nip ;
|
|
||||||
|
|
||||||
: name-count ( pcre extra -- n )
|
|
||||||
PCRE_INFO_NAMECOUNT fullinfo ;
|
|
||||||
|
|
||||||
: name-table ( pcre extra -- addr )
|
|
||||||
[ drop alien-address 32 on-bits unmask ]
|
|
||||||
[ PCRE_INFO_NAMETABLE fullinfo ] 2bi + ;
|
|
||||||
|
|
||||||
: name-entry-size ( pcre extra -- size )
|
|
||||||
PCRE_INFO_NAMEENTRYSIZE fullinfo ;
|
|
||||||
|
|
||||||
: name-table-entry ( addr -- group-index group-name )
|
|
||||||
[ <alien> 1 alien-unsigned-1 ]
|
|
||||||
[ 2 + <alien> utf8 alien>string ] bi ;
|
|
||||||
|
|
||||||
: options ( pcre -- opts )
|
|
||||||
f PCRE_INFO_OPTIONS fullinfo ;
|
|
||||||
|
|
||||||
! Exported
|
|
||||||
: name-table-entries ( pcre extra -- addrs )
|
|
||||||
[ name-table ] [ name-entry-size ] [ name-count ] 2tri
|
|
||||||
gen-array-addrs [ name-table-entry 2array ] map ;
|
|
|
@ -1,18 +1,19 @@
|
||||||
USING:
|
USING: accessors arrays assocs http.client kernel math.ranges
|
||||||
accessors
|
pcre pcre.ffi pcre.private random sequences system tools.test ;
|
||||||
arrays
|
|
||||||
assocs
|
|
||||||
http.client
|
|
||||||
kernel
|
|
||||||
math math.ranges
|
|
||||||
pcre pcre.ffi pcre.info
|
|
||||||
random
|
|
||||||
sequences
|
|
||||||
system
|
|
||||||
tools.test ;
|
|
||||||
QUALIFIED: regexp
|
QUALIFIED: regexp
|
||||||
IN: pcre.tests
|
IN: pcre.tests
|
||||||
|
|
||||||
|
[ { "Bords" "words" "word" } ] [
|
||||||
|
"Bords, words, word." { ", " ", " "." } split-subseqs
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { { 3 "day" } { 2 "month" } { 1 "year" } } ] [
|
||||||
|
"(?P<year>\\d{4})-(?P<month>\\d{2})-(?P<day>\\d{2})"
|
||||||
|
<compiled-pcre> nametable>>
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { 100 110 120 130 } ] [ 100 10 4 gen-array-addrs ] unit-test
|
||||||
|
|
||||||
CONSTANT: iso-date "(?P<year>\\d{4})-(?P<month>\\d{2})-(?P<day>\\d{2})"
|
CONSTANT: iso-date "(?P<year>\\d{4})-(?P<month>\\d{2})-(?P<day>\\d{2})"
|
||||||
|
|
||||||
! On windows the erroffset appears to be set to 0 despite there being
|
! On windows the erroffset appears to be set to 0 despite there being
|
||||||
|
|
|
@ -1,18 +1,51 @@
|
||||||
USING:
|
USING: accessors alien alien.accessors alien.c-types alien.data
|
||||||
accessors
|
alien.enums alien.strings arrays assocs fry io.encodings.string
|
||||||
alien.c-types alien.data alien.enums alien.strings
|
io.encodings.utf8 kernel math math.bitwise mirrors pcre.ffi
|
||||||
arrays
|
sequences sequences.generalizations splitting strings ;
|
||||||
assocs
|
|
||||||
io.encodings.utf8 io.encodings.string
|
|
||||||
kernel
|
|
||||||
math
|
|
||||||
mirrors
|
|
||||||
pcre.ffi pcre.info pcre.utils
|
|
||||||
sequences sequences.generalizations
|
|
||||||
strings ;
|
|
||||||
QUALIFIED: regexp
|
QUALIFIED: regexp
|
||||||
IN: pcre
|
IN: pcre
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: 2with ( param1 param2 obj quot -- obj curry )
|
||||||
|
[ -rot ] dip [ [ rot ] dip call ] 3curry ; inline
|
||||||
|
|
||||||
|
: gen-array-addrs ( base size n -- addrs )
|
||||||
|
iota [ * + ] 2with map ;
|
||||||
|
|
||||||
|
: utf8-start-byte? ( byte -- ? )
|
||||||
|
0xc0 bitand 0x80 = not ;
|
||||||
|
|
||||||
|
: next-utf8-char ( byte-array pos -- pos' )
|
||||||
|
1 + 2dup swap ?nth
|
||||||
|
[ utf8-start-byte? [ nip ] [ next-utf8-char ] if ] [ 2drop f ] if* ;
|
||||||
|
|
||||||
|
: fullinfo ( pcre extra what -- obj )
|
||||||
|
{ int } [ pcre_fullinfo ] with-out-parameters nip ;
|
||||||
|
|
||||||
|
: name-count ( pcre extra -- n )
|
||||||
|
PCRE_INFO_NAMECOUNT fullinfo ;
|
||||||
|
|
||||||
|
: name-table ( pcre extra -- addr )
|
||||||
|
[ drop alien-address 32 on-bits unmask ]
|
||||||
|
[ PCRE_INFO_NAMETABLE fullinfo ] 2bi + ;
|
||||||
|
|
||||||
|
: name-entry-size ( pcre extra -- size )
|
||||||
|
PCRE_INFO_NAMEENTRYSIZE fullinfo ;
|
||||||
|
|
||||||
|
: name-table-entry ( addr -- group-index group-name )
|
||||||
|
[ <alien> 1 alien-unsigned-1 ]
|
||||||
|
[ 2 + <alien> utf8 alien>string ] bi ;
|
||||||
|
|
||||||
|
: options ( pcre -- opts )
|
||||||
|
f PCRE_INFO_OPTIONS fullinfo ;
|
||||||
|
|
||||||
|
: name-table-entries ( pcre extra -- addrs )
|
||||||
|
[ name-table ] [ name-entry-size ] [ name-count ] 2tri
|
||||||
|
gen-array-addrs [ name-table-entry 2array ] map ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
ERROR: malformed-regexp expr error ;
|
ERROR: malformed-regexp expr error ;
|
||||||
ERROR: pcre-error value ;
|
ERROR: pcre-error value ;
|
||||||
|
|
||||||
|
@ -86,7 +119,7 @@ GENERIC: findall ( subject obj -- matches )
|
||||||
|
|
||||||
M: compiled-pcre findall
|
M: compiled-pcre findall
|
||||||
[ <matcher> [ findnext ] follow [ match>> ] map harvest ]
|
[ <matcher> [ findnext ] follow [ match>> ] map harvest ]
|
||||||
[ nametable>> rot [ parse-match ] 2with map ] 2bi >array ;
|
[ nametable>> rot [ parse-match ] 2with { } map-as ] 2bi ;
|
||||||
|
|
||||||
M: string findall
|
M: string findall
|
||||||
<compiled-pcre> findall ;
|
<compiled-pcre> findall ;
|
||||||
|
@ -97,5 +130,15 @@ M: regexp:regexp findall
|
||||||
: matches? ( subject obj -- ? )
|
: matches? ( subject obj -- ? )
|
||||||
dupd findall [ nip length 1 = ] [ ?first ?first ?last = ] 2bi and ;
|
dupd findall [ nip length 1 = ] [ ?first ?first ?last = ] 2bi and ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: replace-all ( seq subseqs new -- seq )
|
||||||
|
swapd '[ _ replace ] reduce ;
|
||||||
|
|
||||||
|
: split-subseqs ( seq subseqs -- seqs )
|
||||||
|
dup first [ replace-all ] keep split-subseq [ >string ] map harvest ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: split ( subject obj -- strings )
|
: split ( subject obj -- strings )
|
||||||
dupd findall [ first second ] map split-subseqs ;
|
dupd findall [ first second ] map split-subseqs ;
|
||||||
|
|
|
@ -1,6 +0,0 @@
|
||||||
USING: pcre.utils tools.test ;
|
|
||||||
IN: pcre.utils.tests
|
|
||||||
|
|
||||||
[ { "Bords" "words" "word" } ] [
|
|
||||||
"Bords, words, word." { ", " ", " "." } split-subseqs
|
|
||||||
] unit-test
|
|
|
@ -1,21 +0,0 @@
|
||||||
USING: assocs fry kernel math mirrors sequences splitting strings ;
|
|
||||||
IN: pcre.utils
|
|
||||||
|
|
||||||
: replace-all ( seq subseqs new -- seq )
|
|
||||||
swapd '[ _ replace ] reduce ;
|
|
||||||
|
|
||||||
: split-subseqs ( seq subseqs -- seqs )
|
|
||||||
dup first [ replace-all ] keep split-subseq [ >string ] map harvest ;
|
|
||||||
|
|
||||||
: 2with ( param1 param2 obj quot -- obj curry )
|
|
||||||
[ -rot ] dip [ [ rot ] dip call ] 3curry ; inline
|
|
||||||
|
|
||||||
: gen-array-addrs ( base size n -- addrs )
|
|
||||||
iota [ * + ] 2with map ;
|
|
||||||
|
|
||||||
: utf8-start-byte? ( byte -- ? )
|
|
||||||
0xc0 bitand 0x80 = not ;
|
|
||||||
|
|
||||||
: next-utf8-char ( byte-array pos -- pos' )
|
|
||||||
1 + 2dup swap ?nth
|
|
||||||
[ utf8-start-byte? [ nip ] [ next-utf8-char ] if ] [ 2drop f ] if* ;
|
|
Loading…
Reference in New Issue