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

Joe Groff 2010-06-05 22:27:26 -07:00
parent 55f3c3da4d
commit 690175a574
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