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

Finish cleanup of regexp

db4
Daniel Ehrenberg 2009-02-18 14:52:10 -06:00
parent b8845cb87e
commit 77b069ee5c
2 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/regexp/dfa/dfa.factor
View File

@ -41,11 +41,11 @@ IN: regexp.dfa
:: new-transitions ( nfa dfa new-states visited-states -- nfa dfa ) :: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
new-states [ nfa dfa ] [ new-states [ nfa dfa ] [
new-states pop :> state pop :> state
state nfa-table find-transitions state nfa find-transitions
[| trans | [| trans |
state trans nfa find-closure :> new-state state trans nfa find-closure :> new-state
state visited-states new-state add-todo-state new-state visited-states new-states add-todo-state
state new-state trans transition make-transition dfa add-transition state new-state trans transition make-transition dfa add-transition
] each ] each
nfa dfa new-states visited-states new-transitions nfa dfa new-states visited-states new-transitions

33
basis/regexp/regexp.factor
View File

@ -7,11 +7,22 @@ regexp.parser regexp.nfa regexp.dfa regexp.traversal
regexp.transition-tables splitting sorting regexp.ast ; regexp.transition-tables splitting sorting regexp.ast ;
IN: regexp IN: regexp
TUPLE: regexp raw options parse-tree dfa ; TUPLE: regexp raw parse-tree options dfa ;
: <optioned-regexp> ( string options -- regexp )
[ dup parse-regexp ] [ string>options ] bi*
2dup <with-options> construct-nfa construct-dfa
regexp boa ;
: <regexp> ( string -- regexp ) "" <optioned-regexp> ;
<PRIVATE
: (match) ( string regexp -- dfa-traverser ) : (match) ( string regexp -- dfa-traverser )
dfa>> <dfa-traverser> do-match ; inline dfa>> <dfa-traverser> do-match ; inline
PRIVATE>
: match ( string regexp -- slice/f ) : match ( string regexp -- slice/f )
(match) return-match ; (match) return-match ;
@ -40,9 +51,13 @@ TUPLE: regexp raw options parse-tree dfa ;
dupd first-match dupd first-match
[ split1-slice swap ] [ "" like f swap ] if* ; [ split1-slice swap ] [ "" like f swap ] if* ;
<PRIVATE
: (re-split) ( string regexp -- ) : (re-split) ( string regexp -- )
over [ [ re-cut , ] keep (re-split) ] [ 2drop ] if ; over [ [ re-cut , ] keep (re-split) ] [ 2drop ] if ;
PRIVATE>
: re-split ( string regexp -- seq ) : re-split ( string regexp -- seq )
[ (re-split) ] { } make ; [ (re-split) ] { } make ;
@ -76,22 +91,6 @@ TUPLE: regexp raw options parse-tree dfa ;
{ "R| " "|" } { "R| " "|" }
} swap [ subseq? not nip ] curry assoc-find drop ; } swap [ subseq? not nip ] curry assoc-find drop ;
PRIVATE>
:: <optioned-regexp> ( string options -- regexp )
string parse-regexp :> tree
options parse-options :> opt
tree opt <with-options> :> ast
regexp new
string >>raw
opt >>options
tree >>parse-tree
tree opt <with-options> construct-nfa construct-dfa >>dfa ;
: <regexp> ( string -- regexp ) "" <optioned-regexp> ;
<PRIVATE
: parsing-regexp ( accum end -- accum ) : parsing-regexp ( accum end -- accum )
lexer get dup skip-blank lexer get dup skip-blank
[ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column [ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column