From: Doug Coleman Date: Fri, 17 Feb 2023 05:05:35 +0000 (-0600) Subject: factor: use more ?if X-Git-Tag: 0.99~548 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=2a849c584aaccb2925eb9de464f741ba5365e542 factor: use more ?if --- diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 96f44afcfb..28796f146c 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -65,7 +65,7 @@ M: struct >c-ptr struct ; inline + '[ [ struct-prototype ] _ _ ?if ] keep memory>struct ; inline PRIVATE> diff --git a/basis/compiler/cfg/intrinsics/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor index 892cbd58ff..dac7fa19ce 100644 --- a/basis/compiler/cfg/intrinsics/misc/misc.factor +++ b/basis/compiler/cfg/intrinsics/misc/misc.factor @@ -15,26 +15,28 @@ IN: compiler.cfg.intrinsics.misc [ [ cc= ^^compare-integer ] binary-op ] [ [ cc= ^^compare ] binary-op ] if ; : emit-special-object ( block node -- block' ) - dup node-input-infos first literal>> [ + [ node-input-infos first literal>> ] + [ ds-drop vm-special-object-offset ^^vm-field ds-push - ] [ emit-primitive ] ?if-old ; + ] [ emit-primitive ] ?if ; : emit-set-special-object ( block node -- block' ) - dup node-input-infos second literal>> [ + [ node-input-infos second literal>> ] + [ ds-drop [ ds-pop ] dip vm-special-object-offset ##set-vm-field, - ] [ emit-primitive ] ?if-old ; + ] [ emit-primitive ] ?if ; : context-object-offset ( n -- n ) cells "context-objects" context offset-of + ; : emit-context-object ( block node -- block' ) - dup node-input-infos first literal>> [ + [ node-input-infos first literal>> ] [ "ctx" vm offset-of ^^vm-field ds-drop swap context-object-offset cell /i 0 ^^slot-imm ds-push - ] [ emit-primitive ] ?if-old ; + ] [ emit-primitive ] ?if ; : emit-identity-hashcode ( -- ) [ diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor index bf945f8a2b..7fa52e9a48 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering.factor @@ -30,16 +30,16 @@ GENERIC: process-instruction ( insn -- insn' ) insn ; : check-redundancy ( insn -- insn' ) - dup >expr dup exprs>vns get at - [ redundant-instruction ] [ useful-instruction ] ?if-old ; + dup >expr + [ exprs>vns get at ] [ redundant-instruction ] [ useful-instruction ] ?if ; M: insn process-instruction - dup rewrite [ process-instruction ] [ ] ?if-old ; + [ rewrite ] [ process-instruction ] ?when ; M: foldable-insn process-instruction - dup rewrite + [ rewrite ] [ process-instruction ] - [ dup defs-vregs length 1 = [ check-redundancy ] when ] ?if-old ; + [ dup defs-vregs length 1 = [ check-redundancy ] when ] ?if ; M: ##copy process-instruction dup [ src>> vreg>vn ] [ dst>> ] bi set-vn ; diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index 8c3323851c..0a4f38b8f5 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -9,9 +9,9 @@ GENERIC: send ( message thread -- ) GENERIC: mailbox-of ( thread -- mailbox ) M: thread mailbox-of - dup mailbox>> + [ mailbox>> ] [ { mailbox } declare ] - [ [ >>mailbox drop ] keep ] ?if-old ; inline + [ [ >>mailbox drop ] keep ] ?if ; inline M: thread send mailbox-of mailbox-put ; diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 35544ae67e..5202a83a91 100644 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -30,9 +30,10 @@ ERROR: no-such-word name vocab ; ERROR: no-such-responder responder ; : base-path ( string -- seq ) - dup responder-nesting get - [ second class-of superclasses-of [ name>> = ] with any? ] with find nip - [ first ] [ no-such-responder ] ?if-old ; + [ + responder-nesting get + [ second class-of superclasses-of [ name>> = ] with any? ] with find nip + ] [ first ] [ no-such-responder ] ?if ; : resolve-base-path ( string -- string' ) "$" ?head [ diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index eba595ebf7..d844c65a94 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -52,8 +52,8 @@ TUPLE: file-responder root hook special index-names allow-listings ; : serve-file ( filename -- response ) dup mime-type - dup file-responder get special>> at - [ call( filename -- response ) ] [ serve-static ] ?if-old ; + [ file-responder get special>> at ] + [ call( filename -- response ) ] [ serve-static ] ?if ; \ serve-file NOTICE add-input-logging @@ -164,8 +164,7 @@ TUPLE: file-responder root hook special index-names allow-listings ; : serve-directory ( filename -- response ) url get path>> "/" tail? [ - dup - find-index [ serve-file ] [ list-directory ] ?if-old + [ find-index ] [ serve-file ] [ list-directory ] ?if ] [ drop url get clone [ "/" append ] change-path diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index 1c08e878fa..59024ff90d 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -21,9 +21,10 @@ TUPLE: anon-var ; [ "}" split1-slice [ - >string dup string>number + >string + [ string>number ] [ 1 + stack-var boa ] - [ [ anon-var new ] [ named-var boa ] if-empty ] ?if-old , + [ [ anon-var new ] [ named-var boa ] if-empty ] ?if , ] [ (parse-interpolate) ] bi* ] when* @@ -77,7 +78,7 @@ MACRO: interpolate ( str -- quot ) [ interpolate ] with-string-writer ; inline : interpolate-locals-quot ( str -- quot ) - [ dup search [ [ ] ] [ [ get ] ] ?if-old ] (interpolate-quot) ; + [ [ search ] [ [ ] ] [ [ get ] ] ?if ] (interpolate-quot) ; MACRO: interpolate-locals ( str -- quot ) interpolate-locals-quot ; diff --git a/basis/io/encodings/gb18030/gb18030.factor b/basis/io/encodings/gb18030/gb18030.factor index 5bec155f97..955423ffb3 100644 --- a/basis/io/encodings/gb18030/gb18030.factor +++ b/basis/io/encodings/gb18030/gb18030.factor @@ -109,11 +109,11 @@ M: gb18030 encode-char { [ length 2 = ] [ first quad-1/3? ] [ second quad-2/4? ] } 1&& ; : decode-quad ( byte-array -- char ) - dup mapping get-global value-at [ ] [ + [ mapping get-global value-at ] [ linear dup gb>u get-global interval-at [ [ bfirst>> - ] [ ufirst>> ] bi + ] [ drop replacement-char ] if* - ] ?if-old ; + ] ?unless ; : four-byte ( stream byte1 byte2 -- char ) rot 2 swap stream-read dup last-bytes? diff --git a/basis/ip-parser/ip-parser.factor b/basis/ip-parser/ip-parser.factor index b5332758db..a4c64aabda 100644 --- a/basis/ip-parser/ip-parser.factor +++ b/basis/ip-parser/ip-parser.factor @@ -19,8 +19,8 @@ ERROR: bad-ipv4-component string ; { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&& ; : ipv4-component ( str -- n ) - dup dup octal? [ oct> ] [ string>number ] if - [ ] [ bad-ipv4-component ] ?if-old ; + [ dup octal? [ oct> ] [ string>number ] if ] + [ bad-ipv4-component ] ?unless ; : split-ipv4 ( str -- array ) "." split [ ipv4-component ] map ; @@ -63,7 +63,7 @@ ERROR: more-than-8-components ; [ ] [ bad-ipv6-component ] ?if-old ; + [ hex> ] [ bad-ipv6-component ] ?unless ; : split-ipv6 ( string -- seq ) ":" split CHAR: . over last member? [ unclip-last ] [ f ] if diff --git a/basis/json/json.factor b/basis/json/json.factor index d98c481abc..1e6bf5cb4a 100644 --- a/basis/json/json.factor +++ b/basis/json/json.factor @@ -39,7 +39,7 @@ SYMBOL: json-depth { "Infinity" [ 1/0. ] } { "-Infinity" [ -1/0. ] } { "NaN" [ 0/0. ] } - [ dup string>number [ ] [ not-a-json-number ] ?if-old ] + [ [ string>number ] [ not-a-json-number ] ?unless ] } case ] dip ; diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index 6c0a58bf29..b8e14271c7 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -16,11 +16,11 @@ M: math-partial integer-op-input-classes ERROR: bad-integer-op word ; M: word integer-op-input-classes - dup "input-classes" word-prop - [ ] [ bad-integer-op ] ?if-old ; + [ "input-classes" word-prop ] + [ bad-integer-op ] ?unless ; : generic-variant ( op -- generic-op/f ) - dup "derived-from" word-prop [ first ] [ ] ?if-old ; + [ "derived-from" word-prop ] [ first ] ?when ; : no-overflow-variant ( op -- fast-op ) H{ diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index b5f8899fb2..275374a824 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -584,8 +584,9 @@ SYNTAX: PEG: [ def call compile :> compiled-def word [ - dup compiled-def compiled-parse - [ ast>> ] [ word parse-failed ] ?if-old + [ compiled-def compiled-parse ] + [ ast>> ] + [ word parse-failed ] ?if ] effect define-declared ] with-compilation-unit ] append! diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index 2f446633c6..f70c123f67 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -42,15 +42,15 @@ MEMO: simple-category-table ( -- table ) simple-category-table at ] } { [ "script=" ?head ] [ - dup simple-script-table at + [ simple-script-table at ] [ ] - [ "script=" prepend bad-class ] ?if-old + [ "script=" prepend bad-class ] ?if ] } [ bad-class ] } cond ; : unicode-class ( name -- class ) - dup parse-unicode-class [ ] [ bad-class ] ?if-old ; + [ parse-unicode-class ] [ bad-class ] ?unless ; : name>class ( name -- class ) >string simple { @@ -106,7 +106,7 @@ MEMO: simple-category-table ( -- table ) ERROR: nonexistent-option name ; : ch>option ( ch -- singleton ) - dup options-assoc at [ ] [ nonexistent-option ] ?if-old ; + [ options-assoc at ] [ nonexistent-option ] ?unless ; : option>ch ( option -- string ) options-assoc value-at ; diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 88268bc43a..9e3045eeb8 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -135,36 +135,36 @@ ERROR: specialized-array-vocab-not-loaded c-type ; M: c-type-word c-array-constructor underlying-type - dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup-word - [ ] [ specialized-array-vocab-not-loaded ] ?if-old ; foldable + [ [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup-word ] + [ specialized-array-vocab-not-loaded ] ?unless ; foldable M: pointer c-array-constructor drop void* c-array-constructor ; M: c-type-word c-(array)-constructor underlying-type - dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup-word - [ ] [ specialized-array-vocab-not-loaded ] ?if-old ; foldable + [ [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup-word ] + [ specialized-array-vocab-not-loaded ] ?unless ; foldable M: pointer c-(array)-constructor drop void* c-(array)-constructor ; M: c-type-word c-direct-array-constructor underlying-type - dup [ name>> "" surround ] [ specialized-array-vocab ] bi lookup-word - [ ] [ specialized-array-vocab-not-loaded ] ?if-old ; foldable + [ [ name>> "" surround ] [ specialized-array-vocab ] bi lookup-word ] + [ specialized-array-vocab-not-loaded ] ?unless ; foldable M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ; M: c-type-word c-array-type underlying-type - dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup-word - [ ] [ specialized-array-vocab-not-loaded ] ?if-old ; foldable + [ [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup-word ] + [ specialized-array-vocab-not-loaded ] ?unless ; foldable M: pointer c-array-type drop void* c-array-type ; M: c-type-word c-array-type? underlying-type - dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup-word - [ ] [ specialized-array-vocab-not-loaded ] ?if-old ; foldable + [ [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup-word ] + [ specialized-array-vocab-not-loaded ] ?unless ; foldable M: pointer c-array-type? drop void* c-array-type? ; diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index d300ee6efa..224d9f9b6f 100644 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -140,7 +140,7 @@ M: object apply-object push-literal ; meta-d clone #return, ; : required-stack-effect ( word -- effect ) - dup stack-effect [ ] [ missing-effect ] ?if-old ; + [ stack-effect ] [ missing-effect ] ?unless ; : with-infer ( quot -- effect visitor ) [ diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor index 4fa5d241c1..4cc3aa6208 100644 --- a/basis/tools/completion/completion.factor +++ b/basis/tools/completion/completion.factor @@ -143,7 +143,7 @@ PRIVATE> ] if ; : chop-; ( seq -- seq' ) - { ";" } split1-last [ ] [ ] ?if-old ; + { ";" } split1-last swap or ; : complete-vocab-list? ( tokens -- ? ) chop-; 1 index-or-length head* "USING:" swap member? ; diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index bf5f1732c5..6630e7f1ad 100644 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -20,9 +20,9 @@ TUPLE: vocab-manifest vocabs libraries ; ERROR: can't-deploy-library-file library ; : copy-library ( dir library -- ) - dup find-library* + [ find-library* ] [ tuck file-name append-path copy-file ] - [ can't-deploy-library-file ] ?if-old ; + [ can't-deploy-library-file ] ?if ; : copy-libraries ( manifest name dir -- ) append-path swap libraries>> [ copy-library ] with each ; diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 4e879690b9..07d94eaa3f 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -62,12 +62,12 @@ PRIVATE> ! that this gives Cf or Mn ! Cf = 26; Mn = 5; Cn = 29 ! Use a compressed array instead? - dup category-map ?nth [ ] [ + [ category-map ?nth ] [ dup 0xE0001 0xE007F between? [ drop 26 ] [ 0xE0100 0xE01EF between? 5 29 ? ] if - ] ?if-old ; inline + ] ?unless ; inline : category ( char -- category ) category-num categories nth ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 154f502da5..666dd40864 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -390,7 +390,7 @@ M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ; M: tuple hashcode* [ tuple-hashcode ] recursive-hashcode ; M: tuple-class new - dup "prototype" word-prop [ (clone) ] [ tuple-layout ] ?if-old ; + [ "prototype" word-prop ] [ (clone) ] [ tuple-layout ] ?if ; M: tuple-class boa [ "boa-check" word-prop [ call ] when* ] diff --git a/core/generic/generic.factor b/core/generic/generic.factor index f4eb15d0dd..2fb3a7f38e 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -87,7 +87,7 @@ GENERIC: next-method-quot* ( class generic combination -- quot ) ERROR: no-next-method method ; : (call-next-method) ( method -- ) - dup next-method-quot [ call ] [ no-next-method ] ?if-old ; + [ next-method-quot ] [ call ] [ no-next-method ] ?if ; ERROR: check-method-error class generic ;