more accessors

db4
Doug Coleman 2008-08-30 20:53:59 -05:00
parent 91d3f64ab2
commit 6ed00241b6
3 changed files with 17 additions and 17 deletions

View File

@ -52,11 +52,11 @@ SYMBOL: rule-sets
dup -roll at* [ nip ] [ drop no-such-rule-set ] if ; dup -roll at* [ nip ] [ drop no-such-rule-set ] if ;
: resolve-delegate ( rule -- ) : resolve-delegate ( rule -- )
dup rule-delegate dup string? dup delegate>> dup string?
[ get-rule-set nip swap set-rule-delegate ] [ 2drop ] if ; [ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ;
: each-rule ( rule-set quot -- ) : each-rule ( rule-set quot -- )
>r rule-set-rules values concat r> each ; inline >r rules>> values concat r> each ; inline
: resolve-delegates ( ruleset -- ) : resolve-delegates ( ruleset -- )
[ resolve-delegate ] each-rule ; [ resolve-delegate ] each-rule ;

View File

@ -45,7 +45,7 @@ RULE: MARK_PREVIOUS mark-previous-rule
TAG: KEYWORDS ( rule-set tag -- key value ) TAG: KEYWORDS ( rule-set tag -- key value )
ignore-case? get <keyword-map> ignore-case? get <keyword-map>
swap child-tags [ over parse-keyword-tag ] each swap child-tags [ over parse-keyword-tag ] each
swap set-rule-set-keywords ; swap (>>keywords) ;
TAGS> TAGS>
@ -72,7 +72,7 @@ TAGS>
] keep ; ] keep ;
: merge-rule-set-props ( props rule-set -- ) : merge-rule-set-props ( props rule-set -- )
[ rule-set-props assoc-union ] keep set-rule-set-props ; [ assoc-union ] change-props drop ;
! Top-level entry points ! Top-level entry points
: parse-mode-tag ( tag -- rule-sets ) : parse-mode-tag ( tag -- rule-sets )

View File

@ -49,41 +49,41 @@ SYMBOL: ignore-case?
swap position-attrs <matcher> ; swap position-attrs <matcher> ;
: shared-tag-attrs ( -- ) : shared-tag-attrs ( -- )
{ "TYPE" string>token set-rule-body-token } , ; inline { "TYPE" string>token (>>body-token) } , ; inline
: delegate-attr ( -- ) : delegate-attr ( -- )
{ "DELEGATE" f set-rule-delegate } , ; { "DELEGATE" f (>>delegate) } , ;
: regexp-attr ( -- ) : regexp-attr ( -- )
{ "HASH_CHAR" f set-rule-chars } , ; { "HASH_CHAR" f (>>chars) } , ;
: match-type-attr ( -- ) : match-type-attr ( -- )
{ "MATCH_TYPE" string>match-type set-rule-match-token } , ; { "MATCH_TYPE" string>match-type (>>match-token) } , ;
: span-attrs ( -- ) : span-attrs ( -- )
{ "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } , { "NO_LINE_BREAK" string>boolean (>>no-line-break?) } ,
{ "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } , { "NO_WORD_BREAK" string>boolean (>>no-word-break?) } ,
{ "NO_ESCAPE" string>boolean set-rule-no-escape? } , ; { "NO_ESCAPE" string>boolean (>>no-escape?) } , ;
: literal-start ( -- ) : literal-start ( -- )
[ parse-literal-matcher swap set-rule-start ] , ; [ parse-literal-matcher >>start drop ] , ;
: regexp-start ( -- ) : regexp-start ( -- )
[ parse-regexp-matcher swap set-rule-start ] , ; [ parse-regexp-matcher >>start drop ] , ;
: literal-end ( -- ) : literal-end ( -- )
[ parse-literal-matcher swap set-rule-end ] , ; [ parse-literal-matcher >>end drop ] , ;
! SPAN's children ! SPAN's children
<TAGS: parse-begin/end-tag ( rule tag -- ) <TAGS: parse-begin/end-tag ( rule tag -- )
TAG: BEGIN TAG: BEGIN
! XXX ! XXX
parse-literal-matcher swap set-rule-start ; parse-literal-matcher >>start drop ;
TAG: END TAG: END
! XXX ! XXX
parse-literal-matcher swap set-rule-end ; parse-literal-matcher >>end drop ;
TAGS> TAGS>