Cleaning up transition tables; making \Z zero-width

db4
Daniel Ehrenberg 2009-03-05 17:44:29 -06:00
parent e1806663d2
commit c31c9fe28d
4 changed files with 19 additions and 21 deletions

View File

@ -28,7 +28,6 @@ M: end-of-file question>quot
[ length swap - 2 <= ]
[ swap tail { "\n" "\r\n" "\r" "" } member? ]
} 2&&
[ [ nip [ length ] keep ] when ] keep
] ;
M: $ question>quot

View File

@ -74,15 +74,10 @@ IN: regexp.minimize
: delete-duplicates ( transitions state-classes -- new-transitions )
'[ drop _ canonical-state? ] assoc-filter ;
: rewrite-duplicates ( new-transitions state-classes -- new-transitions )
'[ [ _ at ] assoc-map ] assoc-map ;
: combine-transitions ( transitions state-classes -- new-transitions )
[ delete-duplicates ] [ rewrite-duplicates ] bi ;
: combine-states ( table -- smaller-table )
dup state-classes
[ combine-transitions ] rewrite-transitions ;
[ transitions-at ] keep
'[ _ delete-duplicates ] change-transitions ;
: minimize ( table -- minimal-table )
clone number-states ; ! combine-states ;
clone number-states combine-states ;

View File

@ -1,3 +1,5 @@
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: regexp tools.test kernel sequences regexp.parser regexp.private
eval strings multiline accessors regexp.matchers ;
IN: regexp-tests
@ -383,14 +385,21 @@ IN: regexp-tests
[ t ] [ "a" R/ \Aa\z/m matches? ] unit-test
[ f ] [ "a\n" R/ \Aa\z/m matches? ] unit-test
[ t ] [ "a\r\n" R/ \Aa\Z/m matches? ] unit-test
[ t ] [ "a\n" R/ \Aa\Z/m matches? ] unit-test
[ f ] [ "a\r\n" R/ \Aa\Z/m matches? ] unit-test
[ f ] [ "a\n" R/ \Aa\Z/m matches? ] unit-test
[ 1 ] [ "a\r\n" R/ \Aa\Z/m count-matches ] unit-test
[ 1 ] [ "a\n" R/ \Aa\Z/m count-matches ] unit-test
[ t ] [ "a" R/ \Aa\Z/m matches? ] unit-test
[ f ] [ "\na" R/ \Aaa\Z/m matches? ] unit-test
[ f ] [ "\r\na" R/ \Aa\Z/m matches? ] unit-test
[ f ] [ "\ra" R/ \Aa\Z/m matches? ] unit-test
[ 1 ] [ "a" R/ \Aa\Z/m count-matches ] unit-test
[ 1 ] [ "\na" R/ \Aaa\Z/m count-matches ] unit-test
[ 1 ] [ "\r\na" R/ \Aa\Z/m count-matches ] unit-test
[ 1 ] [ "\ra" R/ \Aa\Z/m count-matches ] unit-test
[ t ] [ "a" R/ ^a/m matches? ] unit-test
[ f ] [ "\na" R/ ^a/m matches? ] unit-test
[ 1 ] [ "\na" R/ ^a/m count-matches ] unit-test

View File

@ -36,19 +36,14 @@ TUPLE: transition-table transitions start-state final-states ;
: map-set ( assoc quot -- new-assoc )
'[ drop @ dup ] assoc-map ; inline
: rewrite-transitions ( transition-table assoc quot -- transition-table )
[
[ clone ] dip
[ '[ _ condition-at ] change-start-state ]
[ '[ [ _ at ] map-set ] change-final-states ]
[ ] tri
] dip '[ _ @ ] change-transitions ; inline
: number-transitions ( transitions numbering -- new-transitions )
dup '[
[ _ at ]
[ [ _ condition-at ] assoc-map ] bi*
] assoc-map ;
: transitions-at ( transitions numbering -- transitions )
[ number-transitions ] rewrite-transitions ;
: transitions-at ( transition-table assoc -- transition-table )
[ clone ] dip
[ '[ _ condition-at ] change-start-state ]
[ '[ [ _ at ] map-set ] change-final-states ]
[ '[ _ number-transitions ] change-transitions ] tri ;