add flags slot to transitions, get rid of boa usage
parent
b912a73509
commit
d0e0c09124
|
@ -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 transition make-transition r> dfa-table>> add-transition
|
||||||
] curry with each
|
] curry with each
|
||||||
new-transitions
|
new-transitions
|
||||||
] if-empty ;
|
] if-empty ;
|
||||||
|
|
|
@ -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 class make-transition 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 class make-transition 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 ] ;
|
||||||
|
|
|
@ -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 flags ;
|
||||||
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,12 +22,18 @@ TUPLE: default-transition < transition ;
|
||||||
TUPLE: literal obj ;
|
TUPLE: literal obj ;
|
||||||
TUPLE: class obj ;
|
TUPLE: class obj ;
|
||||||
TUPLE: default ;
|
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> ( from to obj -- transition )
|
||||||
literal-transition boa ;
|
literal-transition make-transition ;
|
||||||
: <class-transition> ( from to obj -- transition )
|
: <class-transition> ( from to obj -- transition )
|
||||||
class-transition boa ;
|
class-transition make-transition ;
|
||||||
: <default-transition> ( from to -- transition )
|
: <default-transition> ( from to -- transition )
|
||||||
t default-transition boa ;
|
t default-transition make-transition ;
|
||||||
|
|
||||||
TUPLE: transition-table transitions
|
TUPLE: transition-table transitions
|
||||||
literals classes defaults
|
literals classes defaults
|
||||||
|
|
Loading…
Reference in New Issue