1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors xmode.tokens xmode.keyword-map kernel
4 sequences vectors assocs strings memoize unicode.case
8 TUPLE: string-matcher string ignore-case? ;
10 C: <string-matcher> string-matcher
12 ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet
29 : <rule-set> ( -- ruleset )
33 V{ } clone >>imports ;
35 MEMO: standard-rule-set ( id -- ruleset )
36 <rule-set> swap >>default ;
38 : import-rule-set ( import ruleset -- )
41 : inverted-index ( hashes key index -- )
42 [ swapd push-at ] 2curry each ;
44 : ?push-all ( seq1 seq2 -- seq1+seq2 )
46 over [ [ V{ } like ] dip over push-all ] [ nip ] if
49 : rule-set-no-word-sep* ( ruleset -- str )
52 dup [ keyword-map-no-word-sep* ] when
56 TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ;
60 ! Based on org.gjt.sp.jedit.syntax.ParserRule
73 TUPLE: seq-rule < rule ;
75 TUPLE: span-rule < rule ;
77 TUPLE: eol-span-rule < rule ;
79 : init-span ( rule -- )
80 dup delegate>> [ drop ] [
81 dup body-token>> standard-rule-set
85 : init-eol-span ( rule -- )
87 t >>no-line-break? drop ;
89 TUPLE: mark-following-rule < rule ;
91 TUPLE: mark-previous-rule < rule ;
93 TUPLE: escape-rule < rule ;
95 : <escape-rule> ( string -- rule )
96 f <string-matcher> f f f <matcher>
97 escape-rule new swap >>start ;
99 GENERIC: text-hash-char ( text -- ch )
101 M: f text-hash-char ;
103 M: string-matcher text-hash-char string>> first ;
105 M: regexp text-hash-char drop f ;
107 : rule-chars* ( rule -- string )
108 [ chars>> ] [ start>> ] bi text>>
109 text-hash-char [ suffix ] when* ;
111 : add-rule ( rule ruleset -- )
112 [ dup rule-chars* >upper swap ] dip rules>> inverted-index ;
114 : add-escape-rule ( string ruleset -- )
116 [ <escape-rule> ] dip