updated regexp2 for new compiler, add a slot for lookahead
parent
917ff90fa1
commit
abe2eb462f
|
@ -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 ;
|
||||
|
|
|
@ -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 ] ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue