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

updated regexp2 for new compiler, add a slot for lookahead

db4
Doug Coleman 2008-08-27 15:09:49 -05:00
parent 917ff90fa1
commit abe2eb462f
5 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
unfinished/regexp2/dfa/dfa.factor
View File

@ -42,7 +42,7 @@ IN: regexp2.dfa
dupd pop dup pick find-transitions rot dupd pop dup pick find-transitions rot
[ [
[ [ find-closure ] 2keep nip dupd add-todo-state ] 3keep [ [ find-closure ] 2keep nip dupd add-todo-state ] 3keep
>r swapd transition boa r> dfa-table>> add-transition >r swapd f transition boa r> dfa-table>> add-transition
] curry with each ] curry with each
new-transitions new-transitions
] if-empty ; ] if-empty ;

4
unfinished/regexp2/nfa/nfa.factor
View File

@ -30,10 +30,10 @@ GENERIC: nfa-node ( node -- )
stack [ regexp stack>> ] stack [ regexp stack>> ]
table [ regexp nfa-table>> ] | table [ regexp nfa-table>> ] |
negated? [ negated? [
s0 f obj class boa table add-transition s0 f obj f class boa table add-transition
s0 s1 <default-transition> table add-transition s0 s1 <default-transition> table add-transition
] [ ] [
s0 s1 obj class boa table add-transition s0 s1 obj f class boa table add-transition
] if ] if
s0 s1 2array stack push s0 s1 2array stack push
t s1 table final-states>> set-at ] ; t s1 table final-states>> set-at ] ;

11
unfinished/regexp2/transition-tables/transition-tables.factor
View File

@ -14,7 +14,7 @@ IN: regexp2.transition-tables
: ?insert-at ( value key hash/f -- hash ) : ?insert-at ( value key hash/f -- hash )
[ H{ } clone ] unless* [ insert-at ] keep ; [ H{ } clone ] unless* [ insert-at ] keep ;
TUPLE: transition from to obj ; TUPLE: transition from to obj lookahead ;
TUPLE: literal-transition < transition ; TUPLE: literal-transition < transition ;
TUPLE: class-transition < transition ; TUPLE: class-transition < transition ;
TUPLE: default-transition < transition ; TUPLE: default-transition < transition ;
@ -22,9 +22,12 @@ TUPLE: default-transition < transition ;
TUPLE: literal obj ; TUPLE: literal obj ;
TUPLE: class obj ; TUPLE: class obj ;
TUPLE: default ; TUPLE: default ;
: <literal-transition> ( from to obj -- transition ) literal-transition boa ; : <literal-transition> ( from to obj -- transition )
: <class-transition> ( from to obj -- transition ) class-transition boa ; f literal-transition boa ;
: <default-transition> ( from to -- transition ) t default-transition boa ; : <class-transition> ( from to obj -- transition )
f class-transition boa ;
: <default-transition> ( from to -- transition )
t f default-transition boa ;
TUPLE: transition-table transitions TUPLE: transition-table transitions
literals classes defaults literals classes defaults

5
unfinished/regexp2/traversal/traversal.factor
View File

@ -65,7 +65,10 @@ TUPLE: dfa-traverser
{ [ match-literal ] [ match-class ] [ match-default ] } 3|| ; { [ match-literal ] [ match-class ] [ match-default ] } 3|| ;
: setup-match ( match -- obj state dfa-table ) : setup-match ( match -- obj state dfa-table )
{ current-index>> text>> current-state>> dfa-table>> } get-slots {
[ current-index>> ] [ text>> ]
[ current-state>> ] [ dfa-table>> ]
} cleave
[ nth ] 2dip ; [ nth ] 2dip ;
: do-match ( dfa-traverser -- dfa-traverser ) : do-match ( dfa-traverser -- dfa-traverser )

2
unfinished/regexp2/utils/utils.factor
View File

@ -10,7 +10,7 @@ IN: regexp2.utils
! quot: ( obj -- obj' ) ! quot: ( obj -- obj' )
! pred: ( obj -- <=> ) ! pred: ( obj -- <=> )
>r >r dup slip r> pick over call r> dupd = >r >r dup slip r> pick over call r> dupd =
[ 3drop ] [ (while-changes) ] if ; inline [ 3drop ] [ (while-changes) ] if ; inline recursive
: while-changes ( obj quot pred -- obj' ) : while-changes ( obj quot pred -- obj' )
pick over call (while-changes) ; inline pick over call (while-changes) ; inline