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

View File

@ -42,7 +42,7 @@ IN: regexp2.dfa
dupd pop dup pick find-transitions rot
[
[ [ 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
new-transitions
] if-empty ;

View File

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

View File

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

View File

@ -65,7 +65,10 @@ TUPLE: dfa-traverser
{ [ match-literal ] [ match-class ] [ match-default ] } 3|| ;
: 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 ;
: do-match ( dfa-traverser -- dfa-traverser )

View File

@ -10,7 +10,7 @@ IN: regexp2.utils
! quot: ( obj -- obj' )
! pred: ( obj -- <=> )
>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' )
pick over call (while-changes) ; inline