From 3a47ead313f94be47d8e726caadf4b689005c584 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 23 Feb 2023 19:41:05 -0600 Subject: [PATCH] kernel: ?if-old is just `[ or* ] 2dip if` --- basis/cocoa/pasteboard/pasteboard.factor | 2 +- .../tree/propagation/simple/simple.factor | 4 +-- basis/cpu/ppc/ppc.factor | 32 +++++++++---------- basis/cpu/x86/x86.factor | 8 ++--- .../html/templates/chloe/syntax/syntax.factor | 4 +-- basis/match/match.factor | 6 ++-- basis/persistent/vectors/vectors.factor | 2 +- basis/ui/backend/cocoa/views/views.factor | 4 +-- basis/ui/gadgets/gadgets.factor | 2 +- basis/ui/pixel-formats/pixel-formats.factor | 4 +-- basis/ui/tools/listener/listener.factor | 2 +- basis/unicode/data/data.factor | 4 +-- basis/unicode/normalize/normalize.factor | 2 +- basis/vocabs/generated/generated.factor | 2 +- basis/vocabs/metadata/metadata.factor | 4 +-- basis/xmode/marker/state/state.factor | 3 +- core/combinators/combinators-docs.factor | 2 +- core/continuations/continuations.factor | 2 +- core/generic/math/math.factor | 4 +-- core/generic/single/single.factor | 2 +- core/kernel/kernel-docs.factor | 9 ------ core/kernel/kernel-tests.factor | 4 +-- core/kernel/kernel.factor | 5 ++- core/parser/parser.factor | 2 +- core/vocabs/parser/parser.factor | 2 +- extra/gml/runtime/runtime.factor | 2 +- .../matrices/elimination/elimination.factor | 2 +- extra/multi-methods/multi-methods.factor | 2 +- extra/pairs/pairs.factor | 2 +- extra/reports/noise/noise.factor | 2 +- .../probabilistic-choice.factor | 2 +- misc/vim/syntax/factor/generated.vim | 2 +- 32 files changed, 60 insertions(+), 71 deletions(-) diff --git a/basis/cocoa/pasteboard/pasteboard.factor b/basis/cocoa/pasteboard/pasteboard.factor index d14ed6aa84..752029872e 100644 --- a/basis/cocoa/pasteboard/pasteboard.factor +++ b/basis/cocoa/pasteboard/pasteboard.factor @@ -28,7 +28,7 @@ CONSTANT: NSStringPboardType "NSStringPboardType" : ?pasteboard-string ( pboard error -- str/f ) over pasteboard-string? [ - swap pasteboard-string [ ] [ pasteboard-error ] ?if-old + swap pasteboard-string or* [ pasteboard-error ] unless ] [ nip pasteboard-error ] if ; diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index 7209408d3c..27219188c7 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -102,8 +102,8 @@ ERROR: invalid-outputs #call infos ; [ predicate-output-infos 1array ] 2bi ; : default-output-value-infos ( #call word -- infos ) - "default-output-classes" word-prop - [ class-infos ] [ out-d>> length object-info ] ?if-old ; + "default-output-classes" word-prop or* + [ class-infos ] [ out-d>> length object-info ] if ; : output-value-infos ( #call word -- infos ) { diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 7a5e3a3ad6..81a549118a 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -701,7 +701,7 @@ M:: ppc.64 %convert-integer ( dst src c-type -- ) } case ; M: ppc.32 %load-memory-imm - [ + or* [ pick %trap-null { { c:char [ [ dup ] 2dip LBZ dup EXTSB ] } @@ -717,10 +717,10 @@ M: ppc.32 %load-memory-imm { float-rep [ LFS ] } { double-rep [ LFD ] } } case - ] ?if-old ; + ] if ; M: ppc.64 %load-memory-imm - [ + or* [ pick %trap-null { { c:char [ [ dup ] 2dip LBZ dup EXTSB ] } @@ -738,12 +738,12 @@ M: ppc.64 %load-memory-imm { float-rep [ [ scratch-reg ] dip LI scratch-reg LFSX ] } { double-rep [ [ scratch-reg ] dip LI scratch-reg LFDX ] } } case - ] ?if-old ; + ] if ; M: ppc.32 %load-memory [ [ 0 assert= ] bi@ ] 2dip - [ + or* [ pick %trap-null { { c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] } @@ -759,11 +759,11 @@ M: ppc.32 %load-memory { float-rep [ LFSX ] } { double-rep [ LFDX ] } } case - ] ?if-old ; + ] if ; M: ppc.64 %load-memory [ [ 0 assert= ] bi@ ] 2dip - [ + or* [ pick %trap-null { { c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] } @@ -781,11 +781,11 @@ M: ppc.64 %load-memory { float-rep [ LFSX ] } { double-rep [ LFDX ] } } case - ] ?if-old ; + ] if ; M: ppc.32 %store-memory-imm - [ + or* [ { { c:char [ STB ] } { c:uchar [ STB ] } @@ -800,10 +800,10 @@ M: ppc.32 %store-memory-imm { float-rep [ STFS ] } { double-rep [ STFD ] } } case - ] ?if-old ; + ] if ; M: ppc.64 %store-memory-imm - [ + or* [ { { c:char [ STB ] } { c:uchar [ STB ] } @@ -820,11 +820,11 @@ M: ppc.64 %store-memory-imm { float-rep [ [ scratch-reg ] dip LI scratch-reg STFSX ] } { double-rep [ [ scratch-reg ] dip LI scratch-reg STFDX ] } } case - ] ?if-old ; + ] if ; M: ppc.32 %store-memory [ [ 0 assert= ] bi@ ] 2dip - [ + or* [ { { c:char [ STBX ] } { c:uchar [ STBX ] } @@ -839,11 +839,11 @@ M: ppc.32 %store-memory { float-rep [ STFSX ] } { double-rep [ STFDX ] } } case - ] ?if-old ; + ] if ; M: ppc.64 %store-memory [ [ 0 assert= ] bi@ ] 2dip - [ + or* [ { { c:char [ STBX ] } { c:uchar [ STBX ] } @@ -860,7 +860,7 @@ M: ppc.64 %store-memory { float-rep [ STFSX ] } { double-rep [ STFDX ] } } case - ] ?if-old ; + ] if ; M:: ppc %allot ( dst size class nursery-ptr -- ) ! dst = vm->nursery.here; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 431a6156e9..e583771273 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -400,7 +400,7 @@ M: x86 %convert-integer [ [ drop 1array ] [ [+] ] 2bi ] 2dip ; : (%load-memory) ( dst exclude address rep c-type -- ) - [ + or* [ { { c:char [ 8 %alien-signed-getter ] } { c:uchar [ 8 %alien-unsigned-getter ] } @@ -409,7 +409,7 @@ M: x86 %convert-integer { c:int [ 32 %alien-signed-getter ] } { c:uint [ 32 [ 2drop ] %alien-integer-getter ] } } case - ] [ nipd %copy ] ?if-old ; + ] [ nipd %copy ] if ; M: x86 %load-memory (%memory) (%load-memory) ; @@ -418,7 +418,7 @@ M: x86 %load-memory-imm (%memory-imm) (%load-memory) ; : (%store-memory) ( src exclude address rep c-type -- ) - [ + or* [ { { c:char [ 8 %alien-integer-setter ] } { c:uchar [ 8 %alien-integer-setter ] } @@ -427,7 +427,7 @@ M: x86 %load-memory-imm { c:int [ 32 %alien-integer-setter ] } { c:uint [ 32 %alien-integer-setter ] } } case - ] [ [ nip swap ] dip %copy ] ?if-old ; + ] [ [ nip swap ] dip %copy ] if ; M: x86 %store-memory (%memory) (%store-memory) ; diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor index d0e49d581a..1a48e839a8 100644 --- a/basis/html/templates/chloe/syntax/syntax.factor +++ b/basis/html/templates/chloe/syntax/syntax.factor @@ -21,8 +21,8 @@ CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0" XML-NS: chloe-name http://factorcode.org/chloe/1.0 : required-attr ( tag name -- value ) - [ nip ] [ chloe-name attr ] 2bi - [ ] [ " attribute is required" append throw ] ?if-old ; + [ nip ] [ chloe-name attr ] 2bi or* + [ " attribute is required" append throw ] unless ; : optional-attr ( tag name -- value ) chloe-name attr ; diff --git a/basis/match/match.factor b/basis/match/match.factor index 8fcb303851..d10b737017 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -55,7 +55,7 @@ MACRO: match-cond ( assoc -- quot ) first2 [ [ dupd match ] curry ] dip [ with-variables ] curry rot - [ ?if-old ] 2curry append + [ [ or* ] 2dip if ] 2curry append ] reduce ; GENERIC: replace-patterns ( object -- result ) @@ -75,8 +75,8 @@ M: tuple replace-patterns tuple>array replace-patterns >tuple ; 2dup shorter? [ 2drop f f ] [ - 2dup length head over match - [ swap ?rest ] [ [ rest ] dip (match-first) ] ?if-old + 2dup length head over match or* + [ swap ?rest ] [ [ rest ] dip (match-first) ] if ] if ; : match-first ( seq pattern-seq -- bindings ) diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index 7215d03af3..2316230cfb 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/basis/persistent/vectors/vectors.factor @@ -73,7 +73,7 @@ M: persistent-vector nth-unsafe new-child ] [ [ nip ] 2keep children>> last (ppush-new-tail) - [ swap new-child ] [ swap node-set-last f ] ?if-old + or* [ swap new-child ] [ swap node-set-last f ] if ] if ; : do-expansion ( pvec root expansion/f -- pvec ) diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 9cb48c22ec..2a981f26b6 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -76,8 +76,8 @@ CONSTANT: key-codes } : key-code ( event -- string ? ) - dup -> keyCode key-codes at - [ t ] [ -> charactersIgnoringModifiers CF>string f ] ?if-old ; + dup -> keyCode key-codes at or* + [ t ] [ -> charactersIgnoringModifiers CF>string f ] if ; : event-modifiers ( event -- modifiers ) -> modifierFlags modifiers modifier ; diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index 6259ff6a6e..28bcf8b20a 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -87,7 +87,7 @@ M: gadget contains-point? : pick-up ( point gadget -- child/f ) 2dup [ dup point>rect ] dip children-on [ contains-point? ] with find-last nip - [ [ loc>> v- ] [ pick-up ] bi ] [ nip ] ?if-old ; + or* [ [ loc>> v- ] [ pick-up ] bi ] [ nip ] if ; : max-dims ( seq -- dim ) [ 0 0 ] dip [ first2 swapd [ max ] 2bi@ ] each 2array ; diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index 954828094b..e687886b00 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -50,10 +50,10 @@ ERROR: invalid-pixel-format-attributes world attributes ; TUPLE: pixel-format < disposable world handle ; : ( world attributes -- pixel-format ) - 2dup (make-pixel-format) + 2dup (make-pixel-format) or* [ pixel-format new-disposable swap >>handle swap >>world ] [ invalid-pixel-format-attributes ] - ?if-old ; + if ; M: pixel-format dispose* [ (free-pixel-format) ] [ f >>handle drop ] bi ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index c8bea07478..ccab48c62f 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -365,7 +365,7 @@ M: object accept-completion-hook 2drop ; M: interactor stream-read-quot dup interactor-yield dup array? [ over interactor-finish try-parse - [ ] [ stream-read-quot ] ?if-old + or* [ stream-read-quot ] unless ] [ nip ] if ; : interactor-operation ( gesture interactor -- ? ) diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 07d94eaa3f..451e2773e7 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -88,8 +88,8 @@ PRIVATE> : (chain-decomposed) ( hash value -- newvalue ) [ - 2dup of - [ (chain-decomposed) ] [ 1array nip ] ?if-old + 2dup of or* + [ (chain-decomposed) ] [ 1array nip ] if ] with map concat ; : chain-decomposed ( hash -- newhash ) diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index 233e2ae658..bb12f4c510 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -71,7 +71,7 @@ CONSTANT: final-count 28 string [ >fixnum dup ascii? [ out push ] [ dup hangul? [ hangul>jamo out push-all ] - [ dup quot call [ out push-all ] [ out push ] ?if-old ] if + [ dup quot call or* [ out push-all ] [ out push ] if ] if ] if ] each out "" like dup reorder ; inline diff --git a/basis/vocabs/generated/generated.factor b/basis/vocabs/generated/generated.factor index 8403f90fd6..0d1af5adbf 100644 --- a/basis/vocabs/generated/generated.factor +++ b/basis/vocabs/generated/generated.factor @@ -10,4 +10,4 @@ IN: vocabs.generated [ _ with-current-vocab ] [ ] [ forget-vocab ] cleanup ] with-compilation-unit ] keep - ] ?if-old ; inline + ] [ or* ] 2dip if ; inline diff --git a/basis/vocabs/metadata/metadata.factor b/basis/vocabs/metadata/metadata.factor index a02729238b..169a9e8240 100644 --- a/basis/vocabs/metadata/metadata.factor +++ b/basis/vocabs/metadata/metadata.factor @@ -23,10 +23,10 @@ MEMO: vocab-file-lines ( vocab name -- lines/f ) ] when ; : set-vocab-file-lines ( lines vocab name -- ) - dupd vocab-file-path [ + dupd vocab-file-path or* [ swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty \ vocab-file-lines reset-memoized - ] [ vocab-name no-vocab ] ?if-old ; + ] [ vocab-name no-vocab ] if ; : vocab-resources-path ( vocab -- path/f ) "resources.txt" vocab-file-path ; diff --git a/basis/xmode/marker/state/state.factor b/basis/xmode/marker/state/state.factor index 90b634e074..1bf2744681 100644 --- a/basis/xmode/marker/state/state.factor +++ b/basis/xmode/marker/state/state.factor @@ -38,8 +38,7 @@ SYMBOLS: line last-offset position context f >>in-rule context set ; : init-token-marker ( main prev-context line -- ) - line set - [ ] [ f ] ?if-old context set + line set or* [ f ] unless context set 0 position set 0 last-offset set 0 whitespace-end set diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index de9cf9adbf..404d31bb56 100644 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -170,7 +170,7 @@ ARTICLE: "conditionals" "Conditional combinators" "Forms abstracting a common stack shuffle pattern:" { $subsections if* when* unless* } "Another form abstracting a common stack shuffle pattern:" -{ $subsections ?if-old } +{ $subsections ?if } "Sometimes instead of branching, you just need to pick one of two values:" { $subsections ? } "Two combinators which abstract out nested chains of " { $link if } ":" diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 2df1057526..44ffe40849 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -59,7 +59,7 @@ C: continuation PRIVATE> : ifcc ( capture restore -- ) - [ dummy-1 current-continuation ] 2dip [ dummy-2 ] prepose ?if-old ; inline + [ dummy-1 current-continuation or* ] 2dip [ dummy-2 ] prepose if ; inline : callcc0 ( quot -- ) [ drop ] ifcc ; inline diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index ecb200b350..569a713331 100644 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -46,9 +46,9 @@ ERROR: no-math-method left right generic ; diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor index 103394bc39..c58e4eec54 100644 --- a/core/generic/single/single.factor +++ b/core/generic/single/single.factor @@ -77,7 +77,7 @@ C: predicate-engine : push-method ( method class atomic assoc -- ) dupd [ - [ ] [ H{ } clone ] ?if-old + or* [ H{ } clone ] unless [ methods>> set-at ] keep ] change-at ; diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 7fe2e3d81b..923da3ac3a 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -716,15 +716,6 @@ HELP: unless* "The following two lines are equivalent:" { $code "X [ Y ] unless*" "X dup [ ] [ drop Y ] if" } } ; -HELP: ?if-old -{ $values { "obj" object } { "cond" "a generalized boolean" } { "true" { $quotation ( ..a cond -- ..b ) } } { "false" { $quotation ( ..a default -- ..b ) } } } -{ $description "If the condition is " { $link f } ", the " { $snippet "false" } " quotation is called with the " { $snippet "default" } " value on the stack. Otherwise, the " { $snippet "true" } " quotation is called with the condition on the stack." } -{ $notes -"The following two lines are equivalent:" -{ $code "[ X ] [ Y ] ?if" "dup [ nip X ] [ drop Y ] if" } -"The following two lines are equivalent:" -{ $code "[ ] [ ] ?if" "swap or" } } ; - HELP: die { $description "Starts the front-end processor (FEP), which is a low-level debugger which can inspect memory addresses and the like. The FEP is also entered when a critical error occurs." } { $notes diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 2e048014ab..e662317cfe 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -113,8 +113,8 @@ IN: kernel.tests { 0 } [ f [ 0 ] unless* ] unit-test { t } [ t [ "Hello" ] unless* ] unit-test -{ "2\n" } [ [ 1 2 [ . ] [ sq . ] ?if-old ] with-string-writer ] unit-test -{ "9\n" } [ [ 3 f [ . ] [ sq . ] ?if-old ] with-string-writer ] unit-test +{ "2\n" } [ [ 1 2 or* [ . ] [ sq . ] if ] with-string-writer ] unit-test +{ "9\n" } [ [ 3 f or* [ . ] [ sq . ] if ] with-string-writer ] unit-test { f } [ f (clone) ] unit-test { -123 } [ -123 (clone) ] unit-test diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index f749f8901b..afe28621f9 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -112,9 +112,6 @@ DEFER: if ! Default -: ?if-old ( ..a obj cond true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b ) - pick [ drop [ drop ] 2dip call ] [ 2nip call ] if ; inline - : ?when ( ..a obj cond: ( ..a obj -- obj/f ) true: ( ..a cond -- ..b ) -- ..b ) [ transmute* ] dip when ; inline @@ -288,6 +285,8 @@ UNION: boolean POSTPONE: t POSTPONE: f ; : or ( obj1 obj2 -- ? ) dupd ? ; inline +: or* ( obj1 obj2 -- obj2/obj1 second? ) [ nip t ] [ f ] if* ; inline + : xor ( obj1 obj2 -- ? ) [ f swap ? ] when* ; inline : both? ( x y quot -- ? ) bi@ and ; inline diff --git a/core/parser/parser.factor b/core/parser/parser.factor index e483e0c8d4..002a52bd5b 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -34,7 +34,7 @@ SYMBOL: auto-use? : private? ( word -- ? ) vocabulary>> ".private" tail? ; : use-first-word? ( words -- ? ) - [ length 1 = ] [ ?first dup [ private? not ] [ ] ?if-old ] bi and + [ length 1 = ] [ ?first dup or* [ private? not ] unless ] bi and auto-use? get and ; ! True branch is a singleton public word with no name conflicts diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 9d7f929180..53b1447d24 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -169,7 +169,7 @@ TUPLE: rename word vocab words ; : ( word vocab new-name -- rename ) [ 2dup load-vocab words>> dupd at - [ ] [ swap no-word-in-vocab ] ?if-old + or* [ swap no-word-in-vocab ] unless ] dip associate rename boa ; : add-renamed-word ( word vocab new-name -- ) diff --git a/extra/gml/runtime/runtime.factor b/extra/gml/runtime/runtime.factor index 6803d11060..374a96ee91 100644 --- a/extra/gml/runtime/runtime.factor +++ b/extra/gml/runtime/runtime.factor @@ -59,7 +59,7 @@ ERROR: unbound-name { name gml-name } ; : lookup-name ( name gml -- value ) dupd dictionary-stack>> assoc-stack - [ ] [ unbound-name ] ?if-old ; inline + or* [ unbound-name ] unless ; inline GENERIC: exec-proc ( registers gml proc -- registers gml ) diff --git a/extra/math/matrices/elimination/elimination.factor b/extra/math/matrices/elimination/elimination.factor index c41c82e5a6..7d3896e95d 100644 --- a/extra/math/matrices/elimination/elimination.factor +++ b/extra/math/matrices/elimination/elimination.factor @@ -21,7 +21,7 @@ SYMBOL: matrix : cols ( -- n ) 0 nth-row length ; : skip ( i seq quot -- n ) - over [ find-from drop ] dip swap [ ] [ length ] ?if-old ; inline + over [ find-from drop ] dip swap or* [ length ] unless ; inline : first-col ( row# -- n ) ! First non-zero column diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 34deb25240..bd886ae27b 100644 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -254,7 +254,7 @@ PREDICATE: method-spec < array unclip generic? [ [ class? ] all? ] dip and ; syntax:M: method-spec where - dup unclip method [ ] [ first ] ?if-old where ; + dup unclip method or* [ first ] unless where ; syntax:M: method-spec set-where unclip method set-where ; diff --git a/extra/pairs/pairs.factor b/extra/pairs/pairs.factor index c09be4d895..6c8e4c1dc1 100644 --- a/extra/pairs/pairs.factor +++ b/extra/pairs/pairs.factor @@ -9,7 +9,7 @@ TUPLE: pair value key hash ; f pair boa ; inline : if-hash ( pair true-quot false-quot -- ) - [ dup hash>> ] 2dip ?if-old ; inline + [ hash>> ] -rot ?if ; inline M: pair assoc-size [ assoc-size 1 + ] [ drop 1 ] if-hash ; inline diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 6115516138..9dccb37a3e 100644 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -35,7 +35,7 @@ IN: reports.noise { unless 1/4 } { when* 1/3 } { unless* 1/3 } - { ?if-old 1/2 } + { ?if 1/2 } { cond 1/2 } { case 1/2 } { keep 1 } diff --git a/extra/rosetta-code/probabilistic-choice/probabilistic-choice.factor b/extra/rosetta-code/probabilistic-choice/probabilistic-choice.factor index bdc58c9865..990e82be6b 100644 --- a/extra/rosetta-code/probabilistic-choice/probabilistic-choice.factor +++ b/extra/rosetta-code/probabilistic-choice/probabilistic-choice.factor @@ -41,7 +41,7 @@ MACRO: case-probas ( data -- quot ) [ first2 [ 1quotation ] dip [ swap 2array ] when* ] map 1quotation ; : expected ( data name -- float ) - dupd of [ ] [ values sift sum 1 swap - ] ?if-old ; + dupd of or* [ values sift sum 1 swap - ] unless ; : generate ( # case-probas -- seq ) H{ } clone [ diff --git a/misc/vim/syntax/factor/generated.vim b/misc/vim/syntax/factor/generated.vim index 82e5e6b151..e73ada4c4b 100644 --- a/misc/vim/syntax/factor/generated.vim +++ b/misc/vim/syntax/factor/generated.vim @@ -34,7 +34,7 @@ SynKeywordFactorWord factorWord_io_encodings | syn keyword factorWord_io_encodin SynKeywordFactorWord factorWord_io_encodings_binary | syn keyword factorWord_io_encodings_binary contained binary binary? SynKeywordFactorWord factorWord_io_encodings_utf8 | syn keyword factorWord_io_encodings_utf8 contained >utf8-index code-point-length code-point-offsets utf8 utf8-index> utf8? SynKeywordFactorWord factorWord_io_files | syn keyword factorWord_io_files contained (file-appender) (file-reader) (file-writer) +input+ +output+ +retry+ change-file-contents change-file-lines drain file-contents file-exists? file-lines file-reader file-reader? file-writer file-writer? init-resource-path refill set-file-contents set-file-lines wait-for-fd with-file-appender with-file-reader with-file-writer -SynKeywordFactorWord factorWord_kernel | syn keyword factorWord_kernel contained (clone) -roll -rot -rotd 2bi 2bi* 2bi@ 2curry 2dip 2drop 2dup 2keep 2keepd 2nip 2nipd 2over 2tri 2tri* 2tri@ 2with 3bi 3curry 3dip 3drop 3dup 3keep 3nip 3nipd 3tri 4dip 4drop 4dup 4keep 4nip 5drop 5nip = >boolean ? ?when ?unless ?if ?if-old and assert assert= assert? bi bi* bi-curry bi-curry* bi-curry@ bi@ boa boolean boolean? both? build call callstack callstack>array callstack? clear clone compose composed composed? curried curried? curry die dip do drop dup dupd either? eq? equal? execute get-callstack get-datastack get-retainstack hashcode hashcode* identity-hashcode identity-tuple identity-tuple? if if* keep keepd keepdd loop most negate new nip nipd not null object or over overd pick pickd prepose reach roll rot rotd same? spin swap swapd throw tri tri* tri-curry tri-curry* tri-curry@ tri@ tuck tuple tuple? unless unless* until when when* while while* with withd wrapper wrapper? xor +SynKeywordFactorWord factorWord_kernel | syn keyword factorWord_kernel contained (clone) -roll -rot -rotd 2bi 2bi* 2bi@ 2curry 2dip 2drop 2dup 2keep 2keepd 2nip 2nipd 2over 2tri 2tri* 2tri@ 2with 3bi 3curry 3dip 3drop 3dup 3keep 3nip 3nipd 3tri 4dip 4drop 4dup 4keep 4nip 5drop 5nip = >boolean ? ?when ?unless ?if and assert assert= assert? bi bi* bi-curry bi-curry* bi-curry@ bi@ boa boolean boolean? both? build call callstack callstack>array callstack? clear clone compose composed composed? curried curried? curry die dip do drop dup dupd either? eq? equal? execute get-callstack get-datastack get-retainstack hashcode hashcode* identity-hashcode identity-tuple identity-tuple? if if* keep keepd keepdd loop most negate new nip nipd not null object or or* over overd pick pickd prepose reach roll rot rotd same? spin swap swapd throw tri tri* tri-curry tri-curry* tri-curry@ tri@ tuck tuple tuple? unless unless* until when when* while while* with withd wrapper wrapper? xor SynKeywordFactorWord factorWord_layouts | syn keyword factorWord_layouts contained (first-bignum) (fixnum-bits) (max-array-capacity) 32-bit? 64-bit? bootstrap-cell bootstrap-cell-bits bootstrap-cells bootstrap-first-bignum bootstrap-fixnum-bits bootstrap-max-array-capacity bootstrap-most-negative-fixnum bootstrap-most-positive-fixnum cell cell-bits cells data-alignment first-bignum fixnum-bits hashcode-shift header-bits immediate immediate? leaf-stack-frame-size max-array-capacity mega-cache-size most-negative-fixnum most-positive-fixnum num-types tag-bits tag-fixnum tag-header tag-mask type-number type-numbers untag-fixnum SynKeywordFactorWord factorWord_make | syn keyword factorWord_make contained % %% , ,+ ,, building make SynKeywordFactorWord factorWord_math | syn keyword factorWord_math contained * + - / /f /i /mod 2/ 2^ < <= > >= >bignum >fixnum >float >fraction >integer >rect ?1+ abs align all-integers-from? all-integers? bignum bignum? bit? bitand bitnot bitor bits>double bits>float bitxor complex complex? denominator double>bits each-integer each-integer-from even? find-integer find-integer-from find-last-integer fixnum fixnum? float float>bits float? fp-bitwise= fp-infinity? fp-nan-payload fp-nan? fp-qnan? fp-sign fp-snan? fp-special? gcd if-zero imaginary-part integer integer>fixnum integer>fixnum-strict integer? log2 log2-expects-positive log2-expects-positive? mod neg neg? next-float next-power-of-2 number number= number? numerator odd? power-of-2? prev-float ratio ratio? rational rational? real real-part real? recip rect> recursive-hashcode rem sgn shift simple-gcd sq times u< u<= u> u>= unless-zero unordered? until-zero when-zero zero? -- 2.34.1