-USING: accessors xmode.tokens xmode.keyword-map kernel
-sequences vectors assocs strings memoize unicode.case
-parser-combinators.regexp ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel regexp sequences unicode
+xmode.keyword-map ;
IN: xmode.rules
TUPLE: string-matcher string ignore-case? ;
imports>> push ;
: inverted-index ( hashes key index -- )
+ [ [ { f } ] when-empty ] 2dip
[ swapd push-at ] 2curry each ;
-: ?push-all ( seq1 seq2 -- seq1+seq2 )
- [
- over [ >r V{ } like r> over push-all ] [ nip ] if
- ] when* ;
-
: rule-set-no-word-sep* ( ruleset -- str )
- [ no-word-sep>> ]
- [ keywords>> ] bi
+ [ no-word-sep>> ] [ keywords>> ] bi
dup [ keyword-map-no-word-sep* ] when
"_" 3append ;
TUPLE: rule
no-line-break?
no-word-break?
-no-escape?
start
end
match-token
body-token
delegate
chars
+escape-rule
;
TUPLE: seq-rule < rule ;
: init-span ( rule -- )
dup delegate>> [ drop ] [
dup body-token>> standard-rule-set
- swap (>>delegate)
+ swap delegate<<
] if ;
: init-eol-span ( rule -- )
text-hash-char [ suffix ] when* ;
: add-rule ( rule ruleset -- )
- >r dup rule-chars* >upper swap
- r> rules>> inverted-index ;
+ [ dup rule-chars* >upper swap ] dip rules>> inverted-index ;
: add-escape-rule ( string ruleset -- )
- over [
- [ <escape-rule> ] dip
- 2dup (>>escape-rule)
- add-rule
- ] [
- 2drop
- ] if ;
+ '[
+ <escape-rule> _ [ escape-rule<< ] [ add-rule ] 2bi
+ ] unless-empty ;