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 ;
: resolve-delegate ( rule -- )
dup rule-delegate dup string?
[ get-rule-set nip swap set-rule-delegate ] [ 2drop ] if ;
dup delegate>> dup string?
[ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ;
: 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-delegate ] each-rule ;

View File

@ -45,7 +45,7 @@ RULE: MARK_PREVIOUS mark-previous-rule
TAG: KEYWORDS ( rule-set tag -- key value )
ignore-case? get <keyword-map>
swap child-tags [ over parse-keyword-tag ] each
swap set-rule-set-keywords ;
swap (>>keywords) ;
TAGS>
@ -72,7 +72,7 @@ TAGS>
] keep ;
: 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
: parse-mode-tag ( tag -- rule-sets )

View File

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