66 lines
1.9 KiB
Factor
66 lines
1.9 KiB
Factor
! Copyright (C) 2009 Daniel Ehrenberg.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: regexp regexp.private regexp.classes kernel sequences regexp.negation
|
|
quotations regexp.minimize assocs fry math locals combinators
|
|
accessors words compiler.units ;
|
|
IN: regexp.compiler
|
|
|
|
: literals>cases ( literal-transitions -- case-body )
|
|
[ 1quotation ] assoc-map ;
|
|
|
|
: non-literals>dispatch ( non-literal-transitions -- quot )
|
|
[ [ '[ dup _ class-member? ] ] [ 1quotation ] bi* ] assoc-map
|
|
[ 3drop f ] suffix '[ _ cond ] ;
|
|
|
|
: split-literals ( transitions -- case default )
|
|
! Convert disjunction of literals to literals. Also maybe small ranges.
|
|
>alist [ first integer? ] partition
|
|
[ literals>cases ] [ non-literals>dispatch ] bi* ;
|
|
|
|
USING: kernel.private strings sequences.private ;
|
|
|
|
:: step ( index str case-body final? -- match? )
|
|
index str bounds-check? [
|
|
index 1+ str
|
|
index str nth-unsafe
|
|
case-body case
|
|
] [ final? ] if ; inline
|
|
|
|
: transitions>quot ( transitions final-state? -- quot )
|
|
[ split-literals suffix ] dip
|
|
'[ { array-capacity string } declare _ _ step ] ;
|
|
|
|
: word>quot ( word dfa -- quot )
|
|
[ transitions>> at ]
|
|
[ final-states>> key? ] 2bi
|
|
transitions>quot ;
|
|
|
|
: states>code ( words dfa -- )
|
|
'[
|
|
[
|
|
dup _ word>quot
|
|
(( index string -- ? )) define-declared
|
|
] each
|
|
] with-compilation-unit ;
|
|
|
|
: transitions-at ( transitions assoc -- new-transitions )
|
|
dup '[
|
|
[ _ at ]
|
|
[ [ _ at ] assoc-map ] bi*
|
|
] assoc-map ;
|
|
|
|
: states>words ( dfa -- words dfa )
|
|
dup transitions>> keys [ gensym ] H{ } map>assoc
|
|
[ [ transitions-at ] rewrite-transitions ]
|
|
[ values ]
|
|
bi swap ;
|
|
|
|
: dfa>word ( dfa -- word )
|
|
states>words [ states>code ] keep start-state>> ;
|
|
|
|
: run-regexp ( string word -- ? )
|
|
[ 0 ] 2dip execute ; inline
|
|
|
|
: regexp>quotation ( regexp -- quot )
|
|
compile-regexp dfa>> dfa>word '[ _ run-regexp ] ;
|