]> gitweb.factorcode.org Git - factor.git/commitdiff
core/basis/extra: some [ dup ] dip => dupd cleanup
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 1 Jun 2023 17:38:20 +0000 (10:38 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 1 Jun 2023 17:38:20 +0000 (10:38 -0700)
basis/bootstrap/assembler/ppc.32.linux.factor
basis/bootstrap/assembler/ppc.64.linux.factor
basis/cpu/ppc/ppc.factor
basis/math/functions/functions.factor
basis/opengl/annotations/annotations.factor
core/io/io.factor
extra/gpu/shaders/shaders.factor
extra/mongodb/driver/driver.factor
extra/quadtrees/quadtrees.factor
extra/ui/gadgets/worlds/null/null.factor

index c676b7c579395463f34e7ef0dc4b1375827b5ffd..70b233ddab6785266ec44b9f143a9c4b8ecdb10f 100644 (file)
@@ -20,7 +20,7 @@ CONSTANT: frame-reg 31
 
 : LOAD32 ( r n -- )
     [ -16 shift 0xffff bitand LIS ]
-    [ [ dup ] dip 0xffff bitand ORI ] 2bi ;
+    [ dupd 0xffff bitand ORI ] 2bi ;
 
 : jit-trap-null ( src -- ) drop ;
 : jit-load-vm ( dst -- )
index 08258bd841ffe8724156a10b39bf0ff9794102ee..6f2af8fb2899f9527262f20cf1bb021fb495d569 100644 (file)
@@ -19,7 +19,7 @@ CONSTANT: frame-reg 31
 : nv-int-regs ( -- seq ) 13 31 [a..b] ;
 
 : LOAD64 ( r n -- )
-    [ dup ] dip {
+    dupd {
         [ nip -48 shift 0xffff bitand LIS ]
         [ -32 shift 0xffff bitand ORI ]
         [ drop 32 SLDI ]
index 81a549118a249a025d8509d4ff040516dc543ff5..d5660984e6a4d12c43396413704acc5ca49c7c22 100644 (file)
@@ -72,10 +72,10 @@ M: ppc gc-root-offset
 
 : LOAD32 ( r n -- )
     [ -16 shift 0xffff bitand LIS ]
-    [ [ dup ] dip 0xffff bitand ORI ] 2bi ;
+    [ dupd 0xffff bitand ORI ] 2bi ;
 
 : LOAD64 ( r n -- )
-    [ dup ] dip {
+    dupd {
         [ nip -48 shift 0xffff bitand LIS ]
         [ -32 shift 0xffff bitand ORI ]
         [ drop 32 SLDI ]
index 813152f81a889b761c2b19eb067de228b1719f46..0c1ce94b031b12822dbe012aaa5435dc262fcdf9 100644 (file)
@@ -214,7 +214,7 @@ CONSTANT: log10-2 0x1.34413509f79ffp-2
     most-positive-finite-float between? ; inline
 
 : (bignum-log) ( n log-quot: ( x -- y ) log-2 -- log )
-    [ dup ] dip '[
+    dupd '[
         dup representable-as-float?
         [ >float @ ] [ frexp _ [ _ * ] bi* + ] if
     ] call ; inline
index fc872d943e368b31fcee1605f478a34b689f3034..3282973b69ca8146231dae4c512309432ccdbb7d 100644 (file)
@@ -13,7 +13,7 @@ TUPLE: gl-error-log
 gl-error-log [ V{ } clone ] initialize
 
 : <gl-error-log> ( function code -- gl-error-log )
-    [ dup ] dip <gl-error> now gl-error-log boa ;
+    dupd <gl-error> now gl-error-log boa ;
 
 : log-gl-error ( function -- )
     gl-error-code [ <gl-error-log> gl-error-log get push ] [ drop ] if* ;
index a84c93b3f5de75fa904a45679301f9593e65e002..210f2af9c2fadca93cce2b2ad98bc137ae842c30 100644 (file)
@@ -56,25 +56,25 @@ SYMBOL: error-stream
     input-stream swap with-variable ; inline
 
 : with-input-stream ( stream quot -- )
-    [ with-input-stream* ] curry with-disposal ; inline
+    '[ _ with-input-stream* ] with-disposal ; inline
 
 : with-output-stream* ( stream quot -- )
     output-stream swap with-variable ; inline
 
 : with-output-stream ( stream quot -- )
-    [ with-output-stream* ] curry with-disposal ; inline
+    '[ _ with-output-stream* ] with-disposal ; inline
 
 : with-error-stream* ( stream quot -- )
     error-stream swap with-variable ; inline
 
 : with-error-stream ( stream quot -- )
-    [ with-error-stream* ] curry with-disposal ; inline
+    '[ _ with-error-stream* ] with-disposal ; inline
 
 : with-output+error-stream* ( stream quot -- )
-    [ dup ] dip [ with-error-stream* ] curry with-output-stream* ; inline
+    dupd '[ _ with-error-stream* ] with-output-stream* ; inline
 
 : with-output+error-stream ( stream quot -- )
-    [ with-output+error-stream* ] curry with-disposal ; inline
+    '[ _ with-output+error-stream* ] with-disposal ; inline
 
 : with-output>error ( quot -- )
     error-stream get swap with-output-stream* ; inline
@@ -83,19 +83,19 @@ SYMBOL: error-stream
     output-stream get swap with-error-stream* ; inline
 
 : with-streams* ( input output quot -- )
-    swapd [ with-output-stream* ] curry with-input-stream* ; inline
+    swapd '[ _ with-output-stream* ] with-input-stream* ; inline
 
 : with-streams ( input output quot -- )
     ! We have to dispose of the output stream first, so that
     ! if both streams point to the same FD, we get to flush the
     ! buffer before closing the FD.
-    swapd [ with-output-stream ] curry with-input-stream ; inline
+    swapd '[ _ with-output-stream ] with-input-stream ; inline
 
 : with-input-output+error-streams* ( input output+error quot -- )
-    swapd [ with-output+error-stream* ] curry with-input-stream* ; inline
+    swapd '[ _ with-output+error-stream* ] with-input-stream* ; inline
 
 : with-input-output+error-streams ( input output+error quot -- )
-    swapd [ with-output+error-stream ] curry with-input-stream ; inline
+    swapd '[ _ with-output+error-stream ] with-input-stream ; inline
 
 : print ( str -- ) output-stream get stream-print ; inline
 
@@ -153,7 +153,7 @@ ERROR: invalid-read-buffer buf stream ;
     input-stream get stream-read-partial-into ; inline
 
 : each-stream-line ( ... stream quot: ( ... line -- ... ) -- ... )
-    [ [ stream-readln ] curry ] dip while* ; inline
+    [ '[ _ stream-readln ] ] dip while* ; inline
 
 : each-line ( ... quot: ( ... line -- ... ) -- ... )
     input-stream get swap each-stream-line ; inline
@@ -213,10 +213,10 @@ CONSTANT: each-block-size 65536
     input-stream get stream-contents ; inline
 
 : stream-copy* ( in out -- )
-    [ stream-write ] curry each-stream-block ; inline
+    '[ _ stream-write ] each-stream-block ; inline
 
 : stream-copy ( in out -- )
-    [ [ stream-copy* ] with-disposal ] curry with-disposal ; inline
+    '[ _ [ stream-copy* ] with-disposal ] with-disposal ; inline
 
 ! Default implementations of stream operations in terms of read1/write1
 
@@ -231,7 +231,7 @@ CONSTANT: each-block-size 65536
     ] if ; inline recursive
 
 : finalize-read-until ( seq sep/f -- seq/f sep/f )
-    2dup [ empty? ] [ not ] bi* and [ 2drop f f ] when ; inline
+    [ [ f ] when-empty f ] unless* ; inline
 
 : read-until-loop ( seps stream -- seq sep/f )
     [ [ stream-read1 dup [ rot member? not ] [ nip f ] if* ] 2curry [ ] ]
@@ -247,7 +247,7 @@ M: input-stream stream-contents* (stream-contents-by-length-or-block) ; inline
 M: input-stream stream-seekable? drop f ; inline
 M: input-stream stream-length drop f ; inline
 
-M: output-stream stream-write [ stream-write1 ] curry each ; inline
+M: output-stream stream-write '[ _ stream-write1 ] each ; inline
 M: output-stream stream-flush drop ; inline
 M: output-stream stream-nl CHAR: \n swap stream-write1 ; inline
 M: output-stream stream-seekable? drop f ; inline
index 0abcaab1315eaa22a1002fa000ecea6cf37f6f4d..acb7838b4628e626505caba6b60d46d6a09eebef 100644 (file)
@@ -456,11 +456,11 @@ TUPLE: compile-shader-error shader log ;
 TUPLE: link-program-error program log ;
 
 : throw-compile-shader-error ( shader instance -- * )
-    [ dup ] dip [ gl-shader-info-log ] [ glDeleteShader ] bi
+    dupd [ gl-shader-info-log ] [ glDeleteShader ] bi
     replace-log-line-numbers compile-shader-error boa throw ;
 
 : throw-link-program-error ( program instance -- * )
-    [ dup ] dip [ gl-program-info-log ] [ delete-gl-program ] bi
+    dupd [ gl-program-info-log ] [ delete-gl-program ] bi
     replace-log-line-numbers link-program-error boa throw ;
 
 DEFER: <shader-instance>
index cfc0a84829055fc356624414c99a7f87448145f4..a0132e5f044fa69b53967ae78006fd23ce9474fd 100644 (file)
@@ -154,7 +154,7 @@ M: mdb-collection create-collection ( collection -- )
     [ nip ] if ;
 
 : (ensure-collection) ( collection mdb-instance -- collection )
-    ensure-collection-map [ dup ] dip key?
+    ensure-collection-map dupd key?
     [ ] [
         [ ensure-valid-collection-name ]
         [ create-collection ]
index 2d23015f23503ffa9d58ab0996007feb5f860bc7..f9597e14802a65f8edea387fa1b1c4796a021460 100644 (file)
@@ -193,6 +193,6 @@ M: quadtree clear-assoc ( assoc -- )
     drop ;
 
 : swizzle ( sequence quot -- sequence' )
-    [ dup ] dip map
+    dupd map
     [ zip ] [ rect-containing <quadtree> ] bi
     [ '[ first2 _ set-at ] each ] [ values ] bi ; inline
index 832243032361fb06d09cd91fe710f08d5863507c..374313497c22ce94f56eef54a36be6b4e529400c 100644 (file)
@@ -22,4 +22,4 @@ M: null-world resize-world drop ;
     f swap open-window* ;
 
 : into-window ( world quot -- world )
-    [ dup ] dip with-gl-context ; inline
+    dupd with-gl-context ; inline