]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/xmode/rules/rules.factor
xmode: fix handling of HASH_CHAR and always rules
[factor.git] / basis / xmode / rules / rules.factor
index adc43d7bb6b6364521eb220c564af61dfbcd6436..d68fd18af1be6ea0a2302b5c8d06c9c90d098454 100644 (file)
@@ -1,6 +1,7 @@
-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? ;
@@ -37,16 +38,11 @@ MEMO: standard-rule-set ( id -- ruleset )
     imports>> push ;
 
 : inverted-index ( hashes key index -- )
+    [ [ { f } ] when-empty ] 2dip
     [ swapd push-at ] 2curry each ;
 
-: ?push-all ( seq1 seq2 -- seq1+seq2 )
-    [
-        over [ [ V{ } like ] dip 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 ;
 
@@ -59,13 +55,13 @@ C: <matcher> matcher
 TUPLE: rule
 no-line-break?
 no-word-break?
-no-escape?
 start
 end
 match-token
 body-token
 delegate
 chars
+escape-rule
 ;
 
 TUPLE: seq-rule < rule ;
@@ -77,7 +73,7 @@ TUPLE: eol-span-rule < rule ;
 : init-span ( rule -- )
     dup delegate>> [ drop ] [
         dup body-token>> standard-rule-set
-        swap (>>delegate)
+        swap delegate<<
     ] if ;
 
 : init-eol-span ( rule -- )
@@ -110,10 +106,6 @@ M: regexp text-hash-char drop f ;
     [ 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 ;