1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs kernel regexp sequences unicode
7 TUPLE: string-matcher string ignore-case? ;
9 C: <string-matcher> string-matcher
11 ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet
28 : <rule-set> ( -- ruleset )
32 V{ } clone >>imports ;
34 MEMO: standard-rule-set ( id -- ruleset )
35 <rule-set> swap >>default ;
37 : import-rule-set ( import ruleset -- )
40 : inverted-index ( hashes key index -- )
41 [ swapd push-at ] 2curry each ;
43 : ?push-all ( seq1 seq2 -- seq1+seq2 )
45 over [ [ V{ } like ] dip append! ] [ nip ] if
48 : rule-set-no-word-sep* ( ruleset -- str )
51 dup [ keyword-map-no-word-sep* ] when
55 TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ;
59 ! Based on org.gjt.sp.jedit.syntax.ParserRule
72 TUPLE: seq-rule < rule ;
74 TUPLE: span-rule < rule ;
76 TUPLE: eol-span-rule < rule ;
78 : init-span ( rule -- )
79 dup delegate>> [ drop ] [
80 dup body-token>> standard-rule-set
84 : init-eol-span ( rule -- )
86 t >>no-line-break? drop ;
88 TUPLE: mark-following-rule < rule ;
90 TUPLE: mark-previous-rule < rule ;
92 TUPLE: escape-rule < rule ;
94 : <escape-rule> ( string -- rule )
95 f <string-matcher> f f f <matcher>
96 escape-rule new swap >>start ;
98 GENERIC: text-hash-char ( text -- ch )
100 M: f text-hash-char ;
102 M: string-matcher text-hash-char string>> first ;
104 M: regexp text-hash-char drop f ;
106 : rule-chars* ( rule -- string )
107 [ chars>> ] [ start>> ] bi text>>
108 text-hash-char [ suffix ] when* ;
110 : add-rule ( rule ruleset -- )
111 [ dup rule-chars* >upper swap ] dip rules>> inverted-index ;
113 : add-escape-rule ( string ruleset -- )
115 [ <escape-rule> ] dip