pcre: smaller public interface?

db4
John Benediktsson 2013-11-20 13:29:39 -08:00
parent 239349f84b
commit 8a1b1c8fc5
1 changed files with 24 additions and 33 deletions

View File

@ -1,12 +1,22 @@
USING: accessors alien alien.accessors alien.c-types alien.data
alien.enums alien.strings arrays assocs fry io.encodings.string
io.encodings.utf8 kernel math math.bitwise mirrors pcre.ffi
sequences sequences.generalizations splitting strings ;
io.encodings.utf8 kernel literals math math.bitwise mirrors
pcre.ffi sequences sequences.generalizations splitting strings ;
QUALIFIED: regexp
IN: pcre
ERROR: malformed-regexp expr error ;
ERROR: pcre-error value ;
<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 ;
: 2with ( param1 param2 obj quot -- obj curry )
[ -rot ] dip [ [ rot ] dip call ] 3curry ; inline
@ -20,6 +30,9 @@ IN: pcre
1 + 2dup swap ?nth
[ utf8-start-byte? [ nip ] [ next-utf8-char ] if ] [ 2drop f ] if* ;
: config ( what -- alien )
{ int } [ pcre_config ] with-out-parameters ;
: fullinfo ( pcre extra what -- obj )
{ int } [ pcre_fullinfo ] with-out-parameters nip ;
@ -37,22 +50,14 @@ IN: pcre
[ <alien> 1 alien-unsigned-1 ]
[ 2 + <alien> utf8 alien>string ] bi ;
: options ( pcre -- opts )
: 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: pcre-error value ;
TUPLE: compiled-pcre pcre extra nametable ;
: default-opts ( -- opts )
PCRE_UTF8 PCRE_UCP bitor ;
CONSTANT: default-opts flags{ PCRE_UTF8 PCRE_UCP }
: (pcre) ( expr -- pcre err-message err-offset )
default-opts { c-string int } [ f pcre_compile ] with-out-parameters ;
@ -60,24 +65,18 @@ TUPLE: compiled-pcre pcre extra nametable ;
: <pcre> ( expr -- pcre )
dup (pcre) 2array swap [ 2nip ] [ malformed-regexp ] if* ;
: exec ( pcre extra subject ofs opts -- count match-data )
[ dup length ] 2dip 30 int <c-array> 30 [ pcre_exec ] 2keep drop ;
: <pcre-extra> ( pcre -- pcre-extra )
0 { c-string } [ pcre_study ] with-out-parameters drop ;
: config ( what -- alien )
{ int } [ pcre_config ] with-out-parameters ;
: exec ( pcre extra subject ofs opts -- count match-data )
[ dup length ] 2dip 30 int <c-array> 30 [ pcre_exec ] 2keep drop ;
! Finding stuff
TUPLE: matcher pcre extra subject ofs exec-opts match ;
: <matcher> ( subject compiled-pcre -- matcher )
[ utf8 encode ] dip [ pcre>> ] [ extra>> ] bi rot 0 0 f matcher boa ;
! This handling of zero-length matches is taken from pcredemo.c
: empty-match-opts ( -- opts )
PCRE_NOTEMPTY_ATSTART PCRE_ANCHORED bitor ;
CONSTANT: empty-match-opts flags{ PCRE_NOTEMPTY_ATSTART PCRE_ANCHORED }
: findnext ( matcher -- matcher'/f )
clone dup <mirror> values 6 firstn drop exec
@ -100,7 +99,6 @@ TUPLE: matcher pcre extra subject ofs exec-opts match ;
] 2bi
] if ;
! Result parsing
: substring-list ( subject match-array count -- alien )
{ void* } [ pcre_get_substring_list drop ] with-out-parameters ;
@ -108,7 +106,10 @@ TUPLE: matcher pcre extra subject ofs exec-opts match ;
swapd first2 swap [ substring-list ] keep void* <c-direct-array>
[ utf8 alien>string ] { } map-as [ of swap 2array ] with map-index ;
! High-level
PRIVATE>
TUPLE: compiled-pcre pcre extra nametable ;
: <compiled-pcre> ( expr -- compiled-pcre )
<pcre> dup <pcre-extra> 2dup name-table-entries compiled-pcre boa ;
@ -130,15 +131,5 @@ M: regexp:regexp findall
: matches? ( subject obj -- ? )
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 )
dupd findall [ first second ] map split-subseqs ;