diff --git a/basis/channels/channels.factor b/basis/channels/channels.factor index ea54766ad4..9b5cbee04b 100755 --- a/basis/channels/channels.factor +++ b/basis/channels/channels.factor @@ -3,7 +3,7 @@ ! ! Channels - based on ideas from newsqueak USING: kernel sequences sequences.lib threads continuations -random math ; +random math accessors ; IN: channels TUPLE: channel receivers senders ; @@ -17,14 +17,14 @@ GENERIC: from ( channel -- value ) > push ] curry "channel send" suspend drop ; : (to) ( value receivers -- ) delete-random resume-with yield ; : notify ( continuation channel -- channel ) - [ channel-receivers push ] keep ; + [ receivers>> push ] keep ; : (from) ( senders -- ) delete-random resume ; @@ -32,11 +32,11 @@ GENERIC: from ( channel -- value ) PRIVATE> M: channel to ( value channel -- ) - dup channel-receivers + dup receivers>> dup empty? [ drop dup wait to ] [ nip (to) ] if ; M: channel from ( channel -- value ) [ - notify channel-senders + notify senders>> dup empty? [ drop ] [ (from) ] if ] curry "channel receive" suspend ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 8609cb5b5f..522e7d74c3 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -52,17 +52,17 @@ H{ } clone root-cache set-global SYMBOL: load-help? : load-source ( vocab -- vocab ) - f >>source-loaded? + f over set-vocab-source-loaded? [ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep - t >>source-loaded? + t over set-vocab-source-loaded? [ [ % ] [ call ] if-bootstrapping ] dip ; : load-docs ( vocab -- vocab ) load-help? get [ - f >>docs-loaded? + f over set-vocab-docs-loaded? [ vocab-docs-path [ ?run-file ] when* ] keep - t >>docs-loaded? + t over set-vocab-docs-loaded? ] when ; : reload ( name -- ) diff --git a/extra/asn1/asn1.factor b/extra/asn1/asn1.factor index 7b46aa87de..3509deb2fb 100644 --- a/extra/asn1/asn1.factor +++ b/extra/asn1/asn1.factor @@ -3,7 +3,7 @@ USING: arrays asn1.ldap assocs byte-arrays combinators continuations io io.binary io.streams.string kernel math -math.parser namespaces pack strings sequences ; +math.parser namespaces pack strings sequences accessors ; IN: asn1 @@ -48,16 +48,12 @@ SYMBOL: elements TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ; -: ( -- element ) element new ; - -: set-id ( -- boolean ) - read1 dup elements get set-element-id ; : get-id ( -- id ) - elements get element-id ; + elements get id>> ; : (set-tag) ( -- ) - elements get element-id 31 bitand + elements get id>> 31 bitand dup elements get set-element-tag 31 < [ [ "unsupported tag encoding: #{" % @@ -81,14 +77,14 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ; ] unless elements get set-element-contentlength ; : set-newobj ( -- ) - elements get element-contentlength read + elements get contentlength>> read elements get set-element-newobj ; : set-objtype ( syntax -- ) builtin-syntax 2array [ - elements get element-tagclass swap at - elements get element-encoding swap at - elements get element-tag + elements get tagclass>> swap at + elements get encoding>> swap at + elements get tag>> swap at [ elements get set-element-objtype ] when* @@ -99,7 +95,7 @@ DEFER: read-ber SYMBOL: end : (read-array) ( -- ) - elements get element-id [ + elements get id>> [ elements get element-syntax read-ber dup end = [ drop ] [ , (read-array) ] if ] when ; @@ -115,9 +111,13 @@ SYMBOL: end { "array" [ "" or [ read-array ] with-string-reader ] } } case ; +: set-id ( -- boolean ) + read1 dup elements get set-element-id ; + : read-ber ( syntax -- object ) - elements set - elements get set-element-syntax + element new + swap >>syntax + elements set set-id [ (set-tag) set-tagclass diff --git a/extra/benchmark/fib4/fib4.factor b/extra/benchmark/fib4/fib4.factor index 7cf756e11f..580be0d0ec 100644 --- a/extra/benchmark/fib4/fib4.factor +++ b/extra/benchmark/fib4/fib4.factor @@ -1,4 +1,4 @@ -USING: math kernel debugger ; +USING: accessors math kernel debugger ; IN: benchmark.fib4 TUPLE: box i ; @@ -6,15 +6,15 @@ TUPLE: box i ; C: box : tuple-fib ( m -- n ) - dup box-i 1 <= [ + dup i>> 1 <= [ drop 1 ] [ - box-i 1- + i>> 1- dup tuple-fib swap - box-i 1- + i>> 1- tuple-fib - swap box-i swap box-i + + swap i>> swap i>> + ] if ; : fib-main ( -- ) T{ box f 34 } tuple-fib T{ box f 9227465 } assert= ; diff --git a/extra/benchmark/typecheck1/typecheck1.factor b/extra/benchmark/typecheck1/typecheck1.factor index 434094a2a3..5ffe96292b 100644 --- a/extra/benchmark/typecheck1/typecheck1.factor +++ b/extra/benchmark/typecheck1/typecheck1.factor @@ -1,9 +1,9 @@ -USING: math kernel ; +USING: math kernel accessors ; IN: benchmark.typecheck1 TUPLE: hello n ; -: foo ( obj -- obj n ) 0 100000000 [ over hello-n + ] times ; +: foo ( obj -- obj n ) 0 100000000 [ over n>> + ] times ; : typecheck-main ( -- ) 0 hello boa foo 2drop ; diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index c329977875..1bd81d46ea 100755 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -2,7 +2,7 @@ USING: arrays combinators kernel lists math math.parser namespaces parser lexer parser-combinators parser-combinators.simple promises quotations sequences combinators.lib strings math.order assocs prettyprint.backend memoize unicode.case unicode.categories -combinators.short-circuit ; +combinators.short-circuit accessors ; USE: io IN: regexp @@ -277,7 +277,7 @@ TUPLE: regexp source parser ignore-case? ; : match-head ( string regexp -- end ) do-ignore-case regexp-parser parse dup nil? - [ drop f ] [ car parse-result-unparsed slice-from ] if ; + [ drop f ] [ car parse-result-unparsed from>> ] if ; ! Literal syntax for regexps : parse-options ( string -- ? ) diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index 98276caf83..26147c7867 100755 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -1,6 +1,6 @@ USING: xmode.loader xmode.utilities xmode.rules namespaces strings splitting assocs sequences kernel io.files xml memoize -words globs combinators io.encodings.utf8 sorting ; +words globs combinators io.encodings.utf8 sorting accessors ; IN: xmode.catalog TUPLE: mode file file-name-glob first-line-glob ; @@ -10,9 +10,9 @@ TUPLE: mode file file-name-glob first-line-glob ; TAG: MODE "NAME" over at >r mode new { - { "FILE" f set-mode-file } - { "FILE_NAME_GLOB" f set-mode-file-name-glob } - { "FIRST_LINE_GLOB" f set-mode-first-line-glob } + { "FILE" f (>>file) } + { "FILE_NAME_GLOB" f (>>file-name-glob) } + { "FIRST_LINE_GLOB" f (>>first-line-glob) } } init-from-tag r> rot set-at ; @@ -35,7 +35,7 @@ MEMO: mode-names ( -- modes ) MEMO: (load-mode) ( name -- rule-sets ) modes at [ - mode-file + file>> "resource:extra/xmode/modes/" prepend utf8 parse-mode ] [ @@ -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 ; @@ -65,14 +65,14 @@ SYMBOL: rule-sets over [ dupd update ] [ nip clone ] if ; : import-keywords ( parent child -- ) - over >r [ rule-set-keywords ] bi@ ?update - r> set-rule-set-keywords ; + over >r [ keywords>> ] bi@ ?update + r> (>>keywords) ; : import-rules ( parent child -- ) swap [ add-rule ] curry each-rule ; : resolve-imports ( ruleset -- ) - dup rule-set-imports [ + dup imports>> [ get-rule-set swap rule-sets [ dup resolve-delegates 2dup import-keywords @@ -80,16 +80,19 @@ SYMBOL: rule-sets ] with-variable ] with each ; +ERROR: mutually-recursive-rulesets ruleset ; : finalize-rule-set ( ruleset -- ) - dup rule-set-finalized? { + dup finalized?>> { { f [ - 1 over set-rule-set-finalized? - dup resolve-imports - dup resolve-delegates - t swap set-rule-set-finalized? + { + [ 1 >>finalized? drop ] + [ resolve-imports ] + [ resolve-delegates ] + [ t >>finalized? drop ] + } cleave ] } { t [ drop ] } - { 1 [ "Mutually recursive rule sets" throw ] } + { 1 [ mutually-recursive-rulesets ] } } case ; : finalize-mode ( rulesets -- ) @@ -107,8 +110,8 @@ SYMBOL: rule-sets dup [ glob-matches? ] [ 2drop f ] if ; : suitable-mode? ( file-name first-line mode -- ? ) - tuck mode-first-line-glob ?glob-matches - [ 2drop t ] [ mode-file-name-glob ?glob-matches ] if ; + tuck first-line-glob>> ?glob-matches + [ 2drop t ] [ file-name-glob>> ?glob-matches ] if ; : find-mode ( file-name first-line -- mode ) modes diff --git a/extra/xmode/loader/loader.factor b/extra/xmode/loader/loader.factor index 8039db0ac9..28c0de406a 100755 --- a/extra/xmode/loader/loader.factor +++ b/extra/xmode/loader/loader.factor @@ -1,7 +1,7 @@ USING: xmode.loader.syntax xmode.tokens xmode.rules xmode.keyword-map xml.data xml.utilities xml assocs kernel combinators sequences math.parser namespaces parser -xmode.utilities regexp io.files ; +xmode.utilities regexp io.files accessors ; IN: xmode.loader ! Based on org.gjt.sp.jedit.XModeHandler @@ -10,13 +10,13 @@ IN: xmode.loader >props drop ; TAG: IMPORT "DELEGATE" swap at swap import-rule-set ; TAG: TERMINATE - "AT_CHAR" swap at string>number swap set-rule-set-terminate-char ; + "AT_CHAR" swap at string>number >>terminate-char drop ; RULE: SEQ seq-rule shared-tag-attrs delegate-attr literal-start ; @@ -45,7 +45,7 @@ RULE: MARK_PREVIOUS mark-previous-rule TAG: KEYWORDS ( rule-set tag -- key value ) ignore-case? get swap child-tags [ over parse-keyword-tag ] each - swap set-rule-set-keywords ; + swap (>>keywords) ; TAGS> @@ -55,29 +55,29 @@ TAGS> : (parse-rules-tag) ( tag -- rule-set ) { - { "SET" string>rule-set-name set-rule-set-name } - { "IGNORE_CASE" string>boolean set-rule-set-ignore-case? } - { "HIGHLIGHT_DIGITS" string>boolean set-rule-set-highlight-digits? } - { "DIGIT_RE" ? set-rule-set-digit-re } + { "SET" string>rule-set-name (>>name) } + { "IGNORE_CASE" string>boolean (>>ignore-case?) } + { "HIGHLIGHT_DIGITS" string>boolean (>>highlight-digits?) } + { "DIGIT_RE" ? (>>digit-re) } { "ESCAPE" f add-escape-rule } - { "DEFAULT" string>token set-rule-set-default } - { "NO_WORD_SEP" f set-rule-set-no-word-sep } + { "DEFAULT" string>token (>>default) } + { "NO_WORD_SEP" f (>>no-word-sep) } } init-from-tag ; : parse-rules-tag ( tag -- rule-set ) dup (parse-rules-tag) [ - dup rule-set-ignore-case? ignore-case? [ + dup ignore-case?>> ignore-case? [ swap child-tags [ parse-rule-tag ] with each ] with-variable ] 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 ) dup "RULES" tags-named [ - parse-rules-tag dup rule-set-name swap + parse-rules-tag dup name>> swap ] H{ } map>assoc swap "PROPS" tag-named [ parse-props-tag over values diff --git a/extra/xmode/loader/syntax/syntax.factor b/extra/xmode/loader/syntax/syntax.factor index 8b66774d7f..5512b68b04 100644 --- a/extra/xmode/loader/syntax/syntax.factor +++ b/extra/xmode/loader/syntax/syntax.factor @@ -49,41 +49,41 @@ SYMBOL: ignore-case? swap position-attrs ; : 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 >start drop ; TAG: END ! XXX - parse-literal-matcher swap set-rule-end ; + parse-literal-matcher >>end drop ; TAGS> diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor index 911397cc20..707449a23f 100755 --- a/extra/xmode/marker/marker.factor +++ b/extra/xmode/marker/marker.factor @@ -3,7 +3,7 @@ USING: kernel namespaces xmode.rules xmode.tokens xmode.marker.state xmode.marker.context xmode.utilities xmode.catalog sequences math assocs combinators combinators.lib strings regexp splitting parser-combinators ascii unicode.case -combinators.short-circuit ; +combinators.short-circuit accessors ; ! Based on org.gjt.sp.jedit.syntax.TokenMarker @@ -12,11 +12,11 @@ combinators.short-circuit ; : keyword-number? ( keyword -- ? ) { - [ current-rule-set rule-set-highlight-digits? ] + [ current-rule-set highlight-digits?>> ] [ dup [ digit? ] contains? ] [ dup [ digit? ] all? [ - current-rule-set rule-set-digit-re + current-rule-set digit-re>> dup [ dupd matches? ] [ drop f ] if ] unless* ] @@ -26,10 +26,10 @@ combinators.short-circuit ; keyword-number? DIGIT and ; : mark-keyword ( keyword -- id ) - current-rule-set rule-set-keywords at ; + current-rule-set keywords>> at ; : add-remaining-token ( -- ) - current-rule-set rule-set-default prev-token, ; + current-rule-set default>> prev-token, ; : mark-token ( -- ) current-keyword @@ -48,9 +48,9 @@ M: rule match-position drop position get ; : can-match-here? ( matcher rule -- ? ) match-position { [ over ] - [ over matcher-at-line-start? over zero? implies ] - [ over matcher-at-whitespace-end? over whitespace-end get = implies ] - [ over matcher-at-word-start? over last-offset get = implies ] + [ over at-line-start?>> over zero? implies ] + [ over at-whitespace-end?>> over whitespace-end get = implies ] + [ over at-word-start?>> over last-offset get = implies ] } 0&& 2nip ; : rest-of-line ( -- str ) @@ -72,19 +72,19 @@ M: regexp text-matches? >r >string r> match-head ; : rule-start-matches? ( rule -- match-count/f ) - dup rule-start tuck swap can-match-here? [ - rest-of-line swap matcher-text text-matches? + dup start>> tuck swap can-match-here? [ + rest-of-line swap text>> text-matches? ] [ drop f ] if ; : rule-end-matches? ( rule -- match-count/f ) dup mark-following-rule? [ - dup rule-start swap can-match-here? 0 and + dup start>> swap can-match-here? 0 and ] [ - dup rule-end tuck swap can-match-here? [ + dup end>> tuck swap can-match-here? [ rest-of-line - swap matcher-text context get line-context-end or + swap text>> context get end>> or text-matches? ] [ drop f @@ -94,10 +94,10 @@ M: regexp text-matches? DEFER: get-rules : get-always-rules ( vector/f ruleset -- vector/f ) - f swap rule-set-rules at ?push-all ; + f swap rules>> at ?push-all ; : get-char-rules ( vector/f char ruleset -- vector/f ) - >r ch>upper r> rule-set-rules at ?push-all ; + >r ch>upper r> rules>> at ?push-all ; : get-rules ( char ruleset -- seq ) f -rot [ get-char-rules ] keep get-always-rules ; @@ -108,13 +108,13 @@ GENERIC: handle-rule-end ( match-count rule -- ) : find-escape-rule ( -- rule ) context get dup - line-context-in-rule-set rule-set-escape-rule [ ] [ - line-context-parent line-context-in-rule-set - dup [ rule-set-escape-rule ] when + in-rule-set>> escape-rule>> [ ] [ + parent>> in-rule-set>> + dup [ escape-rule>> ] when ] ?if ; : check-escape-rule ( rule -- ? ) - rule-no-escape? [ f ] [ + no-escape?>> [ f ] [ find-escape-rule dup [ dup rule-start-matches? dup [ swap handle-rule-start @@ -138,9 +138,9 @@ GENERIC: handle-rule-end ( match-count rule -- ) ] when* ; : rule-match-token* ( rule -- id ) - dup rule-match-token { - { f [ dup rule-body-token ] } - { t [ current-rule-set rule-set-default ] } + dup match-token>> { + { f [ dup body-token>> ] } + { t [ current-rule-set default>> ] } [ ] } case nip ; @@ -156,8 +156,8 @@ M: seq-rule handle-rule-start ?end-rule mark-token add-remaining-token - tuck rule-body-token next-token, - rule-delegate [ push-context ] when* ; + tuck body-token>> next-token, + delegate>> [ push-context ] when* ; UNION: abstract-span-rule span-rule eol-span-rule ; @@ -167,8 +167,8 @@ M: abstract-span-rule handle-rule-start add-remaining-token tuck rule-match-token* next-token, ! ... end subst ... - dup context get set-line-context-in-rule - rule-delegate push-context ; + dup context get (>>in-rule) + delegate>> push-context ; M: span-rule handle-rule-end 2drop ; @@ -197,15 +197,16 @@ M: mark-previous-rule handle-rule-start ] when ; : check-end-delegate ( -- ? ) - context get line-context-parent [ - line-context-in-rule [ + context get parent>> [ + in-rule>> [ dup rule-end-matches? dup [ [ swap handle-rule-end ?end-rule mark-token add-remaining-token - ] keep context get line-context-parent line-context-in-rule rule-match-token* next-token, + ] keep context get parent>> in-rule>> + rule-match-token* next-token, pop-context seen-whitespace-end? on t ] [ drop check-escape-rule ] if @@ -213,9 +214,9 @@ M: mark-previous-rule handle-rule-start ] [ f ] if* ; : handle-no-word-break ( -- ) - context get line-context-parent [ - line-context-in-rule [ - dup rule-no-word-break? [ + context get parent>> [ + in-rule>> [ + dup no-word-break?>> [ rule-match-token* prev-token, pop-context ] [ drop ] if @@ -231,11 +232,11 @@ M: mark-previous-rule handle-rule-start : (check-word-break) ( -- ) check-rule - 1 current-rule-set rule-set-default next-token, ; + 1 current-rule-set default>> next-token, ; : rule-set-empty? ( ruleset -- ? ) - dup rule-set-rules assoc-empty? - swap rule-set-keywords assoc-empty? and ; + [ rules>> ] [ keywords>> ] bi + [ assoc-empty? ] bi@ and ; : check-word-break ( -- ? ) current-char dup blank? [ @@ -285,9 +286,9 @@ M: mark-previous-rule handle-rule-start check-rule ; : unwind-no-line-break ( -- ) - context get line-context-parent [ - line-context-in-rule [ - rule-no-line-break? [ + context get parent>> [ + in-rule>> [ + no-line-break?>> [ pop-context unwind-no-line-break ] when diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor index 2cf12f301d..9075ff6329 100755 --- a/extra/xmode/marker/state/state.factor +++ b/extra/xmode/marker/state/state.factor @@ -1,4 +1,4 @@ -USING: xmode.marker.context xmode.rules symbols +USING: xmode.marker.context xmode.rules symbols accessors xmode.tokens namespaces kernel sequences assocs math ; IN: xmode.marker.state @@ -9,13 +9,13 @@ SYMBOLS: line last-offset position context escaped? process-escape? delegate-end-escaped? ; : current-rule ( -- rule ) - context get line-context-in-rule ; + context get in-rule>> ; : current-rule-set ( -- rule ) - context get line-context-in-rule-set ; + context get in-rule-set>> ; : current-keywords ( -- keyword-map ) - current-rule-set rule-set-keywords ; + current-rule-set keywords>> ; : token, ( from to id -- ) 2over = [ 3drop ] [ >r line get subseq r> , ] if ; @@ -32,9 +32,8 @@ SYMBOLS: line last-offset position context context [ ] change ; : pop-context ( -- ) - context get line-context-parent - dup context set - f swap set-line-context-in-rule ; + context get parent>> + f >>in-rule context set ; : init-token-marker ( main prev-context line -- ) line set diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index 50d2924b61..4ab45d7539 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -30,10 +30,10 @@ finalized? V{ } clone >>imports ; MEMO: standard-rule-set ( id -- ruleset ) - [ set-rule-set-default ] keep ; + swap >>default ; : import-rule-set ( import ruleset -- ) - rule-set-imports push ; + imports>> push ; : inverted-index ( hashes key index -- ) [ swapd push-at ] 2curry each ; @@ -44,8 +44,9 @@ MEMO: standard-rule-set ( id -- ruleset ) ] when* ; : rule-set-no-word-sep* ( ruleset -- str ) - dup rule-set-no-word-sep - swap rule-set-keywords dup [ keyword-map-no-word-sep* ] when + [ no-word-sep>> ] + [ keywords>> ] bi + dup [ keyword-map-no-word-sep* ] when "_" 3append ; ! Match restrictions @@ -73,14 +74,14 @@ TUPLE: span-rule < rule ; TUPLE: eol-span-rule < rule ; : init-span ( rule -- ) - dup rule-delegate [ drop ] [ - dup rule-body-token standard-rule-set - swap set-rule-delegate + dup delegate>> [ drop ] [ + dup body-token>> standard-rule-set + swap (>>delegate) ] if ; : init-eol-span ( rule -- ) dup init-span - t swap set-rule-no-line-break? ; + t >>no-line-break? drop ; TUPLE: mark-following-rule < rule ; @@ -101,18 +102,17 @@ M: string-matcher text-hash-char string-matcher-string first ; M: regexp text-hash-char drop f ; : rule-chars* ( rule -- string ) - dup rule-chars - swap rule-start matcher-text + [ chars>> ] [ start>> ] bi text>> text-hash-char [ suffix ] when* ; : add-rule ( rule ruleset -- ) >r dup rule-chars* >upper swap - r> rule-set-rules inverted-index ; + r> rules>> inverted-index ; : add-escape-rule ( string ruleset -- ) over [ - >r r> - 2dup set-rule-set-escape-rule + [ ] dip + 2dup (>>escape-rule) add-rule ] [ 2drop diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor index 49a1265b09..e4946701dd 100755 --- a/extra/xmode/utilities/utilities-tests.factor +++ b/extra/xmode/utilities/utilities-tests.factor @@ -14,7 +14,7 @@ TUPLE: company employees type ; : V{ } clone f company boa ; -: add-employee company-employees push ; +: add-employee employees>> push ; >name) } { f (>>description) } } init-from-tag swap add-employee ; TAGS> @@ -32,7 +32,7 @@ TAGS> : parse-company-tag [ - { { "type" >upper set-company-type } } + { { "type" >upper (>>type) } } init-from-tag dup ] keep children>> [ tag? ] filter