Merge branch 'master' of git://factorcode.org/git/factor
commit
6dabf1f019
|
@ -27,7 +27,6 @@ IN: regexp.dfa
|
||||||
nfa-table>> transitions>>
|
nfa-table>> transitions>>
|
||||||
[ at keys ] curry map concat
|
[ at keys ] curry map concat
|
||||||
eps swap remove ;
|
eps swap remove ;
|
||||||
! dup t member? [ t swap remove t suffix ] when ;
|
|
||||||
|
|
||||||
: add-todo-state ( state regexp -- )
|
: add-todo-state ( state regexp -- )
|
||||||
2dup visited-states>> key? [
|
2dup visited-states>> key? [
|
||||||
|
|
|
@ -33,7 +33,19 @@ IN: regexp
|
||||||
dupd match
|
dupd match
|
||||||
[ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ;
|
[ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ;
|
||||||
|
|
||||||
: match-head ( string regexp -- end ) match length>> 1- ;
|
: match-head ( string regexp -- end/f ) match [ length>> 1- ] [ f ] if* ;
|
||||||
|
|
||||||
|
: match-at ( string m regexp -- n/f finished? )
|
||||||
|
[
|
||||||
|
2dup swap length > [ 2drop f f ] [ tail-slice t ] if
|
||||||
|
] dip swap [ match-head f ] [ 2drop f t ] if ;
|
||||||
|
|
||||||
|
: match-range ( string m regexp -- a/f b/f )
|
||||||
|
3dup match-at over [
|
||||||
|
drop nip rot drop dupd +
|
||||||
|
] [
|
||||||
|
[ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
|
||||||
|
] if ;
|
||||||
|
|
||||||
: initial-option ( regexp option -- regexp' )
|
: initial-option ( regexp option -- regexp' )
|
||||||
over options>> conjoin ;
|
over options>> conjoin ;
|
||||||
|
|
|
@ -32,7 +32,12 @@ TUPLE: transition-table transitions start-state final-states ;
|
||||||
H{ } clone >>transitions
|
H{ } clone >>transitions
|
||||||
H{ } clone >>final-states ;
|
H{ } clone >>final-states ;
|
||||||
|
|
||||||
|
: maybe-initialize-key ( key hashtable -- )
|
||||||
|
2dup key? [ 2drop ] [ H{ } clone -rot set-at ] if ;
|
||||||
|
|
||||||
: set-transition ( transition hash -- )
|
: set-transition ( transition hash -- )
|
||||||
|
#! set the state as a key
|
||||||
|
2dup [ to>> ] dip maybe-initialize-key
|
||||||
[ [ to>> ] [ obj>> ] [ from>> ] tri ] dip
|
[ [ to>> ] [ obj>> ] [ from>> ] tri ] dip
|
||||||
2dup at* [ 2nip insert-at ]
|
2dup at* [ 2nip insert-at ]
|
||||||
[ drop >r >r H{ } clone [ insert-at ] keep r> r> set-at ] if ;
|
[ drop >r >r H{ } clone [ insert-at ] keep r> r> set-at ] if ;
|
||||||
|
|
|
@ -43,6 +43,10 @@ TUPLE: dfa-traverser
|
||||||
dup save-final-state
|
dup save-final-state
|
||||||
] when text-finished? ;
|
] when text-finished? ;
|
||||||
|
|
||||||
|
: print-flags ( dfa-traverser -- dfa-traverser )
|
||||||
|
dup [ current-state>> ] [ traversal-flags>> ] bi
|
||||||
|
;
|
||||||
|
|
||||||
: increment-state ( dfa-traverser state -- dfa-traverser )
|
: increment-state ( dfa-traverser state -- dfa-traverser )
|
||||||
[
|
[
|
||||||
[ 1+ ] change-current-index dup current-state>> >>last-state
|
[ 1+ ] change-current-index dup current-state>> >>last-state
|
||||||
|
|
Loading…
Reference in New Issue