steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor regexp.compiler to not all with-compilation-unit so much; benchmark.regex-dna loads about twice as fast now

db4
Slava Pestov 2009-03-16 05:00:27 -05:00
parent 27a68b8aa4
commit 58d997de5c
2 changed files with 13 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/regexp/compiler/compiler.factor
View File

@ -104,13 +104,11 @@ C: <box> box
transitions>quot ; transitions>quot ;
: states>code ( words dfa -- ) : states>code ( words dfa -- )
[ '[
'[ dup _ word>quot
dup _ word>quot (( last-match index string -- ? ))
(( last-match index string -- ? )) define-declared
define-declared ] each ;
] each
] with-compilation-unit ;
: states>words ( dfa -- words dfa ) : states>words ( dfa -- words dfa )
dup transitions>> keys [ gensym ] H{ } map>assoc dup transitions>> keys [ gensym ] H{ } map>assoc
@ -123,12 +121,9 @@ C: <box> box
PRIVATE> PRIVATE>
: simple-define-temp ( quot effect -- word )
[ define-temp ] with-compilation-unit ;
: dfa>word ( dfa -- quot ) : dfa>word ( dfa -- quot )
dfa>main-word execution-quot '[ drop [ f ] 2dip @ ] dfa>main-word execution-quot '[ drop [ f ] 2dip @ ]
(( start-index string regexp -- i/f )) simple-define-temp ; (( start-index string regexp -- i/f )) define-temp ;
: dfa>shortest-word ( dfa -- word ) : dfa>shortest-word ( dfa -- word )
t shortest? [ dfa>word ] with-variable ; t shortest? [ dfa>word ] with-variable ;

17
basis/regexp/regexp.factor
View File

@ -4,7 +4,7 @@ USING: accessors combinators kernel kernel.private math sequences
sequences.private strings sets assocs prettyprint.backend sequences.private strings sets assocs prettyprint.backend
prettyprint.custom make lexer namespaces parser arrays fry locals prettyprint.custom make lexer namespaces parser arrays fry locals
regexp.parser splitting sorting regexp.ast regexp.negation regexp.parser splitting sorting regexp.ast regexp.negation
regexp.compiler words call call.private math.ranges ; regexp.compiler compiler.units words call call.private math.ranges ;
IN: regexp IN: regexp
TUPLE: regexp TUPLE: regexp
@ -35,7 +35,7 @@ M: lookbehind question>quot ! Returns ( index string -- ? )
: match-index-from ( i string regexp -- index/f ) : match-index-from ( i string regexp -- index/f )
! This word is unsafe. It assumes that i is a fixnum ! This word is unsafe. It assumes that i is a fixnum
! and that string is a string. ! and that string is a string.
dup dfa>> execute-unsafe( index string regexp -- i/f ) ; dup dfa>> execute-unsafe( index string regexp -- i/f ) ; inline
GENERIC: end/start ( string regexp -- end start ) GENERIC: end/start ( string regexp -- end start )
M: regexp end/start drop length 0 ; M: regexp end/start drop length 0 ;
@ -129,31 +129,28 @@ PRIVATE>
GENERIC: compile-regexp ( regex -- regexp ) GENERIC: compile-regexp ( regex -- regexp )
: regexp-initial-word ( i string regexp -- i/f ) : regexp-initial-word ( i string regexp -- i/f )
compile-regexp match-index-from ; [ compile-regexp ] with-compilation-unit match-index-from ;
: do-compile-regexp ( regexp -- regexp ) M: regexp compile-regexp ( regexp -- regexp )
dup '[ dup '[
dup \ regexp-initial-word = dup \ regexp-initial-word =
[ drop _ get-ast ast>dfa dfa>word ] when [ drop _ get-ast ast>dfa dfa>word ] when
] change-dfa ; ] change-dfa ;
M: regexp compile-regexp ( regexp -- regexp )
do-compile-regexp ;
M: reverse-regexp compile-regexp ( regexp -- regexp ) M: reverse-regexp compile-regexp ( regexp -- regexp )
t backwards? [ do-compile-regexp ] with-variable ; t backwards? [ call-next-method ] with-variable ;
DEFER: compile-next-match DEFER: compile-next-match
: next-initial-word ( i string regexp -- i start end string ) : next-initial-word ( i string regexp -- i start end string )
compile-next-match do-next-match ; [ compile-next-match ] with-compilation-unit do-next-match ;
: compile-next-match ( regexp -- regexp ) : compile-next-match ( regexp -- regexp )
dup '[ dup '[
dup \ next-initial-word = [ dup \ next-initial-word = [
drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi
'[ { array-capacity string regexp } declare _ _ next-match ] '[ { array-capacity string regexp } declare _ _ next-match ]
(( i string regexp -- i start end string )) simple-define-temp (( i string regexp -- i start end string )) define-temp
] when ] when
] change-next-match ; ] change-next-match ;