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