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

xmode.catalog: pre-convert globs to regexes in modes hash so their compilation is memoized

db4
Joe Groff 2010-06-05 22:27:26 -07:00
parent a1f1330586
commit 90537038ea
1 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
basis/xmode/catalog/catalog.factor
View File

@ -1,7 +1,8 @@
USING: xmode.loader xmode.utilities xmode.rules namespaces USING: xmode.loader xmode.utilities xmode.rules namespaces
strings splitting assocs sequences kernel io.files xml memoize strings splitting assocs sequences kernel io.files xml memoize
words globs combinators io.encodings.utf8 io.pathnames sorting words globs combinators io.encodings.utf8 io.pathnames sorting
accessors xml.data xml.traversal xml.syntax ; accessors regexp unicode.case xml.data xml.traversal
xml.syntax ;
IN: xmode.catalog IN: xmode.catalog
TUPLE: mode file file-name-glob first-line-glob ; TUPLE: mode file file-name-glob first-line-glob ;
@ -15,6 +16,8 @@ TAG: MODE parse-mode-tag
{ "FILE_NAME_GLOB" f file-name-glob<< } { "FILE_NAME_GLOB" f file-name-glob<< }
{ "FIRST_LINE_GLOB" f first-line-glob<< } { "FIRST_LINE_GLOB" f first-line-glob<< }
} init-from-tag } init-from-tag
[ [ >case-fold <glob> ] [ f ] if* ] change-file-name-glob
[ [ >case-fold <glob> ] [ f ] if* ] change-first-line-glob
] dip ] dip
rot set-at ; rot set-at ;
@ -106,12 +109,12 @@ ERROR: mutually-recursive-rulesets ruleset ;
: reset-modes ( -- ) : reset-modes ( -- )
\ (load-mode) reset-memoized ; \ (load-mode) reset-memoized ;
: ?glob-matches ( string glob/f -- ? ) : ?matches ( string glob/f -- ? )
dup [ glob-matches? ] [ 2drop f ] if ; [ >case-fold ] dip dup [ matches? ] [ 2drop f ] if ;
: suitable-mode? ( file-name first-line mode -- ? ) : suitable-mode? ( file-name first-line mode -- ? )
[ nip ] 2keep first-line-glob>> ?glob-matches [ nip ] 2keep first-line-glob>> ?matches
[ 2drop t ] [ file-name-glob>> ?glob-matches ] if ; [ 2drop t ] [ file-name-glob>> ?matches ] if ;
: ?find-mode ( file-name first-line -- mode/f ) : ?find-mode ( file-name first-line -- mode/f )
[ file-name ] dip [ file-name ] dip