]> gitweb.factorcode.org Git - factor.git/commitdiff
factor: use more ?if
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 17 Feb 2023 05:05:35 +0000 (23:05 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 26 Feb 2023 23:11:04 +0000 (17:11 -0600)
20 files changed:
basis/classes/struct/struct.factor
basis/compiler/cfg/intrinsics/misc/misc.factor
basis/compiler/cfg/value-numbering/value-numbering.factor
basis/concurrency/messaging/messaging.factor
basis/furnace/utilities/utilities.factor
basis/http/server/static/static.factor
basis/interpolate/interpolate.factor
basis/io/encodings/gb18030/gb18030.factor
basis/ip-parser/ip-parser.factor
basis/json/json.factor
basis/math/partial-dispatch/partial-dispatch.factor
basis/peg/peg.factor
basis/regexp/parser/parser.factor
basis/specialized-arrays/specialized-arrays.factor
basis/stack-checker/backend/backend.factor
basis/tools/completion/completion.factor
basis/tools/deploy/backend/backend.factor
basis/unicode/data/data.factor
core/classes/tuple/tuple.factor
core/generic/generic.factor

index 96f44afcfb936eeae8d9b4d3c141898893e49182..28796f146c1a25ebf42ad9839a560335f9d3aabb 100644 (file)
@@ -65,7 +65,7 @@ M: struct >c-ptr
 <PRIVATE
 
 : init-struct ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
-    '[ dup struct-prototype _ _ ?if-old ] keep memory>struct ; inline
+    '[ [ struct-prototype ] _ _ ?if ] keep memory>struct ; inline
 
 PRIVATE>
 
index 892cbd58ff4d51d4974eaaac493b1b56179860ad..dac7fa19ce9345a0087bdc924b0a33ade0de4bd2 100644 (file)
@@ -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 ( -- )
     [
index bf945f8a2b9b9539cb260e6aa70151dee53d3383..7fa52e9a4813789525c09e925bad79be99d6947f 100644 (file)
@@ -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 ;
index 8c3323851c344e9466bef4075930a7ca6754fa02..0a4f38b8f550a06893750847e7b71adeef53daea 100644 (file)
@@ -9,9 +9,9 @@ GENERIC: send ( message thread -- )
 GENERIC: mailbox-of ( thread -- mailbox )
 
 M: thread mailbox-of
-    dup mailbox>>
+    [ mailbox>> ]
     [ { mailbox } declare ]
-    [ <mailbox> [ >>mailbox drop ] keep ] ?if-old ; inline
+    [ <mailbox> [ >>mailbox drop ] keep ] ?if ; inline
 
 M: thread send
     mailbox-of mailbox-put ;
index 35544ae67e66ac4185eaaac5684cf747791a5b42..5202a83a91d8fb6604534838d524e1e9422958b1 100644 (file)
@@ -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 [
index eba595ebf7d9180b0d685f91ebfff09a14fd7ed7..d844c65a9454c7e2746522fba8538fb8c4605405 100644 (file)
@@ -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 <permanent-redirect>
index 1c08e878fa4f1c46bb90cedfe2c0a80c0a97cd2c..59024ff90d35cf4b54956c1bae0860e1631212d3 100644 (file)
@@ -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 ;
index 5bec155f975d6cc563dc92227c566fdc35115ef9..955423ffb33f3a42b192f7927d9dacf7d1d2892e 100644 (file)
@@ -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?
index b5332758dbe4d371ae83d04d15dbade6f4b05f5c..a4c64aabda3e6f5a7d38be2940f9820da2d726bf 100644 (file)
@@ -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 ;
 <PRIVATE
 
 : ipv6-component ( str -- n )
-    dup hex> [ ] [ bad-ipv6-component ] ?if-old ;
+    [ hex> ] [ bad-ipv6-component ] ?unless ;
 
 : split-ipv6 ( string -- seq )
     ":" split CHAR: . over last member? [ unclip-last ] [ f ] if
index d98c481abc6b6a05181132a63a404365d809d918..1e6bf5cb4ae956fcb5c2580af7adc268340f1cd3 100644 (file)
@@ -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 ;
 
index 6c0a58bf29b4f12c8fcb05ab8ba9d712811a6b55..b8e14271c764da49fd02a4f2271aa4e5a32a447e 100644 (file)
@@ -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{
index b5f8899fb2a994306e4b4fe8f052d97885aafb00..275374a824f5c6a4b7bded6cae1d0203c72d59b1 100644 (file)
@@ -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!
index 2f446633c6b99c8e7525b0f05aee3bf6f591dedc..f70c123f67a53cef49987708cfcd6487a1e51a26 100644 (file)
@@ -42,15 +42,15 @@ MEMO: simple-category-table ( -- table )
             simple-category-table at <category-class>
         ] }
         { [ "script=" ?head ] [
-            dup simple-script-table at
+            [ simple-script-table at ]
             [ <script-class> ]
-            [ "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 ;
index 88268bc43a9e6f0add2197dae51cfdd4e7a01a1f..9e3045eeb8384121f0ecf6c2200168da07cb82a6 100644 (file)
@@ -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>> "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup-word
-    [ ] [ specialized-array-vocab-not-loaded ] ?if-old ; foldable
+    [ [ name>> "<direct-" "-array>" 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? ;
 
index d300ee6efaf056765160fcf681c25caebda1c364..224d9f9b6fa494db461dcdba6a1f77deacf50eb9 100644 (file)
@@ -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 )
     [
index 4fa5d241c1bbfdbc1af6e39e1f26a06d2b2610fd..4cc3aa6208dbe47d46bcffacfc395341db356c4d 100644 (file)
@@ -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? ;
index bf5f1732c55f30e45aeca31f842548e4fc847cd5..6630e7f1adbc9eb62ebd3921a18f4c035cc513af 100644 (file)
@@ -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 ;
index 4e879690b951ba2259a7ddd5fe2fe7a1bef48d3a..07d94eaa3f21dc82845e4fadd63de2979546666d 100644 (file)
@@ -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 ;
index 154f502da5bfd5e9df1ecc81d56853d3b08799d0..666dd40864764cb2514a72017102091d92e0c8c3 100644 (file)
@@ -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 <tuple> ] ?if-old ;
+    [ "prototype" word-prop ] [ (clone) ] [ tuple-layout <tuple> ] ?if ;
 
 M: tuple-class boa
     [ "boa-check" word-prop [ call ] when* ]
index f4eb15d0dd184436b7ab915148df568ee4c098f8..2fb3a7f38e34f4e57737eb37535eb2fdeffe84f1 100644 (file)
@@ -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 ;