! XXX: check HASH_CHAR for full prefix, not just first character
: char<< ( value object -- )
- [ ?first ] dip chars<< ;
+ '[ 1 head _ chars<< ] unless-empty ;
: regexp-attr ( -- )
- { "HASH_CHAR" f char<< } ,
- { "HASH_CHARS" f chars<< } , ;
+ { "HASH_CHARS" f chars<< } ,
+ { "HASH_CHAR" f char<< } , ;
: match-type-attr ( -- )
{ "MATCH_TYPE" string>match-type match-token<< } , ;
: match-group-regexp ( regexp n -- skip-regexp match-regexp )
[ [ options>> options>string ] [ raw>> ] bi ] dip
CHAR: ( pick nth-index cut CHAR: ) over index 1 + head
- rot '[ H{ } [ _ <optioned-regexp> ] cache ] bi@ ;
+ rot '[ _ H{ } [ <optioned-regexp> ] 2cache ] bi@ ;
: skip-first-match ( match regexp -- tailseq )
first-match [ seq>> ] [ to>> ] bi tail ;
DEFER: get-rules
-: get-always-rules ( vector/f ruleset -- vector/f )
- f swap rules>> at ?push-all ;
+: get-always-rules ( ruleset -- vector/f )
+ f swap rules>> at ;
-: get-char-rules ( vector/f char ruleset -- vector/f )
- [ ch>upper ] dip rules>> at ?push-all ;
+: get-char-rules ( char ruleset -- vector/f )
+ [ ch>upper ] dip rules>> at ;
: get-rules ( char ruleset -- seq )
- [ f ] 2dip [ get-char-rules ] keep get-always-rules ;
+ [ get-char-rules ] [ get-always-rules ] bi [ append ] when* ;
GENERIC: handle-rule-start ( match-count rule -- )
[ [ { f } ] when-empty ] 2dip
[ swapd push-at ] 2curry each ;
-: ?push-all ( seq1 seq2 -- seq1+seq2 )
- [
- over [ [ V{ } like ] dip append! ] [ 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 ;