add flags slot to transitions, get rid of boa usage

db4
Doug Coleman 2008-08-27 16:22:34 -05:00
parent b912a73509
commit d0e0c09124
3 changed files with 13 additions and 7 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 transition make-transition 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 class make-transition table add-transition
s0 s1 <default-transition> table add-transition
] [
s0 s1 obj class boa table add-transition
s0 s1 obj class make-transition 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 flags ;
TUPLE: literal-transition < transition ;
TUPLE: class-transition < transition ;
TUPLE: default-transition < transition ;
@ -22,12 +22,18 @@ TUPLE: default-transition < transition ;
TUPLE: literal obj ;
TUPLE: class obj ;
TUPLE: default ;
: make-transition ( from to obj class -- obj )
new
swap >>obj
swap >>to
swap >>from
H{ } clone >>flags ;
: <literal-transition> ( from to obj -- transition )
literal-transition boa ;
literal-transition make-transition ;
: <class-transition> ( from to obj -- transition )
class-transition boa ;
class-transition make-transition ;
: <default-transition> ( from to -- transition )
t default-transition boa ;
t default-transition make-transition ;
TUPLE: transition-table transitions
literals classes defaults