factor: use 2length

diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 812ee8632b87295923e7b2e0d03881b87d82470d..2ad5708d5849544bb143e1b76a1281a1e4670b0c 100644 (file)
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -344,7 +344,7 @@ cell 4 = [
         [ 2drop 0 < ]
         [ [ drop ] 2dip length > ]
         [ drop > ]
-    } 3|| [ 3drop f ] [ slice boa ] if swap [ [ length ] bi@ ] 2keep ;
+    } 3|| [ 3drop f ] [ slice boa ] if swap [ 2length ] 2keep ;
 
 { 0 3 f { 1 2 3 } } [ { 1 2 3 } -10 3 "hello" coalescing-bug-1 ] unit-test
 { 0 3 f { 1 2 3 } } [ { 1 2 3 } 0 7 "hello" coalescing-bug-1 ] unit-test

diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor
index e02e03558b6c25445d9411f3e18101e89dc147df..6ef9ce54c10a7ab530432e1e8afc7fdea9186704 100644 (file)
--- a/basis/compiler/tree/builder/builder.factor
+++ b/basis/compiler/tree/builder/builder.factor
@@ -44,6 +44,6 @@ PRIVATE>
         {
             { [ dup not ] [ ] }
             { [ dup ends-with-terminate? ] [ out-d [ f swap <#push> ] map append ] }
-            [ in-d' out-d [ [ length ] bi@ assert= ] [ <#copy> suffix ] 2bi ]
+            [ in-d' out-d [ 2length assert= ] [ <#copy> suffix ] 2bi ]
         } cond
     ] [ inference-error? ] ignore-error/f ;

diff --git a/basis/compiler/tree/escape-analysis/recursive/recursive.factor b/basis/compiler/tree/escape-analysis/recursive/recursive.factor
index 4fb1c282b628f41c83666c361b511d45a0e4ea4f..3f8746dd4119e827c1d87d5e81de4453ea01f836 100644 (file)
--- a/basis/compiler/tree/escape-analysis/recursive/recursive.factor
+++ b/basis/compiler/tree/escape-analysis/recursive/recursive.factor
@@ -11,7 +11,7 @@ IN: compiler.tree.escape-analysis.recursive
 : congruent? ( alloc1 alloc2 -- ? )
     {
         { [ 2dup [ boolean? ] either? ] [ eq? ] }
-        { [ 2dup [ length ] bi@ = not ] [ 2drop f ] }
+        { [ 2dup 2length @ = not ] [ 2drop f ] }
         [ [ [ allocation ] bi@ congruent? ] 2all? ]
     } cond ;
 

diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor
index 1cf40ba8378ac76e37f6efe69348bf7bc1802b84..bd77defd6a1eb26a1276af8d0e6d8be47ab933d2 100644 (file)
--- a/basis/compiler/tree/normalization/normalization.factor
+++ b/basis/compiler/tree/normalization/normalization.factor
@@ -40,7 +40,7 @@ M: #branch normalize*
     [
         [ nip ] [
             dup [ +top+ eq? ] trim-head
-            [ [ length ] bi@ - tail* ] keep append
+            [ 2length - tail* ] keep append
         ] if
     ] 3map ;
 

diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor
index fd6885610fa6184cd789826329fb63db8b9c59bc..b03d48403265f85991afa195e4ddb7853a3f18d4 100644 (file)
--- a/basis/compiler/tree/propagation/simple/simple.factor
+++ b/basis/compiler/tree/propagation/simple/simple.factor
@@ -47,7 +47,7 @@ M: #declare propagate-before
 ERROR: invalid-outputs #call infos ;
 
 : check-outputs ( #call infos -- infos )
-    over out-d>> over [ length ] bi@ =
+    over out-d>> over 2length =
     [ nip ] [ invalid-outputs ] if ;
 
 : call-outputs-quot ( #call word -- infos )

diff --git a/basis/io/directories/directories-tests.factor b/basis/io/directories/directories-tests.factor
index 92d7e52d8da48edb016476d9055ce01587000338..0f2933cdb6d9520f218f1ba4557c124172ae8a4b 100644 (file)
--- a/basis/io/directories/directories-tests.factor
+++ b/basis/io/directories/directories-tests.factor
@@ -289,7 +289,7 @@ tools.test ;
 
             ! preserve file traversal order, but sort
             ! alphabetically for cross-platform testing
-            [ [ length ] bi@ = ] monotonic-split
+            [ 2length = ] monotonic-split
             [ sort ] map concat
         ] with-variable
     ] with-test-directory

diff --git a/basis/ip-parser/ip-parser.factor b/basis/ip-parser/ip-parser.factor
index 5e6398d0ac4f675aa9fda0d926bbbf3443d7e03b..46a936200517b5b4f7059c95135fa1867aa0e488 100644 (file)
--- a/basis/ip-parser/ip-parser.factor
+++ b/basis/ip-parser/ip-parser.factor
@@ -71,7 +71,7 @@ ERROR: more-than-8-components ;
     [ [ parse-ipv4 append ] unless-empty ] bi* ;
 
 : pad-ipv6 ( string1 string2 -- seq )
-    2dup [ length ] bi@ + 8 swap -
+    2dup 2length + 8 swap -
     dup 0 < [ more-than-8-components ] when
     <byte-array> glue ;
 

diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor
index 1cf63e22f0e91dd06f92c79a267ceb3bec82b0a0..b94426ecddb83f973e2b50e43aa4b45cba3a1f10 100644 (file)
--- a/basis/math/polynomials/polynomials.factor
+++ b/basis/math/polynomials/polynomials.factor
@@ -29,7 +29,7 @@ PRIVATE>
 ALIAS: n*p n*v
 
 : pextend-conv ( p q -- p' q' )
-    2dup [ length ] bi@ + 1 - 2pad-tail ;
+    2dup 2length + 1 - 2pad-tail ;
 
 : p* ( p q -- r )
     2unempty pextend-conv
@@ -52,7 +52,7 @@ ERROR: negative-power-polynomial p n ;
 
 : p/mod-setup ( p p -- p p n )
     2ptrim
-    2dup [ length ] bi@ -
+    2dup 2length -
     dup 1 < [ drop 1 ] when
     [ over length + 0 pad-head pextend ] keep 1 + ;
 

diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor
index 7d004911f965717b780033cbaefcf3b07850ccdc..d048a668cb49d1469e8d67c672553d8ead200de7 100644 (file)
--- a/basis/mime/multipart/multipart.factor
+++ b/basis/mime/multipart/multipart.factor
@@ -49,7 +49,7 @@ ERROR: mime-decoding-ran-out-of-bytes ;
         [ mime-write ]
         [ swap length tail-slice >>bytes ] bi*
     ] [
-        tuck [ length ] bi@ - 1 - cut-slice
+        tuck 2length - 1 - cut-slice
         [ mime-write ]
         [ >>bytes ] bi* fill-bytes
         dup end-of-stream?>> [ dump-until-separator ] unless

diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor
index 0e7b1ee1d4011c3d051beda41fbe322792e6aa91..668850af8b98da563f26aae163c380c98f9ed822 100644 (file)
--- a/basis/tools/completion/completion.factor
+++ b/basis/tools/completion/completion.factor
@@ -44,7 +44,7 @@ PRIVATE>
 
 : score ( full fuzzy -- n )
     [
-        [ [ length ] bi@ - 15 swap [-] 3 /f ] 2keep
+        [ 2length - 15 swap [-] 3 /f ] 2keep
         runs [
             [ 0 [ pick score-1 max ] reduce nip ] keep
             length * +

diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor
index 70750cac6b56547d72b56fd0d0cb168333b68bce..1d5beec95f26988fe49ddffabab2f9b620430283 100644 (file)
--- a/basis/xml/tokenize/tokenize.factor
+++ b/basis/xml/tokenize/tokenize.factor
@@ -103,7 +103,7 @@ HINTS: next* { spot } ;
 
 : take-string ( match -- string )
     [ spot get (take-string) [ missing-close ] unless ]
-    [ dupd [ length ] bi@ - over shorten "" like ] bi ;
+    [ dupd 2length - over shorten "" like ] bi ;
 
 : expect ( string -- )
     dup length spot get '[ _ [ char>> ] keep next* ] "" replicate-as

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 9c545565fe24515f3244708ca7c4ed2b58d74491..6643d18cf493537156d4c042b937b6b172c62b91 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -84,7 +84,7 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
     ] if-bootstrapping ; inline
 
 : pad-slots ( seq class -- seq' class )
-    [ all-slots ] keep 2over [ length ] bi@ 2dup > [
+    [ all-slots ] keep 2over 2length 2dup > [
         [ nip swap ] 2dip too-many-slots
     ] [
         drop [

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index ecad0eb4df71607b575a52fe8a71a6d719b4c624..0f8699fd431e47b540ce0dc9f9e825cdb47293ae 100644 (file)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -2,7 +2,7 @@
 ! See https://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs kernel kernel.private math
 math.order math.private quotations sequences sequences.private
-sets sorting words ;
+sets words ;
 IN: combinators
 
 ! Most of these combinators have compile-time expansions in

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index ed39ba81a3a29ad336c575b25fb57fab9ac6b309..14461f519ee722040e6440b76f5492137de892ce 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -476,9 +476,9 @@ PRIVATE>
 : change-nth ( ..a i seq quot: ( ..a elt -- ..b newelt ) -- ..b )
     [ [ nth ] dip call ] 2keepd set-nth-unsafe ; inline
 
-: min-length ( seq1 seq2 -- n ) [ length ] bi@ min ; inline
+: min-length ( seq1 seq2 -- n ) 2length min ; inline
 
-: max-length ( seq1 seq2 -- n ) [ length ] bi@ max ; inline
+: max-length ( seq1 seq2 -- n ) 2length max ; inline
 
 <PRIVATE
 
@@ -519,7 +519,7 @@ PRIVATE>
     [ nth-unsafe ] tri-curry@ tri ; inline
 
 : setup-3each ( seq1 seq2 seq3 -- n quot )
-    [ [ length ] tri@ min min check-length ]
+    [ 3length min min check-length ]
     [ [ 3nth-unsafe ] 3curry ] 3bi ; inline
 
 : (3each) ( seq1 seq2 seq3 quot -- n quot' )
@@ -802,7 +802,7 @@ M: sequence <=>
     [ 2nth-unsafe <=> ] [ [ length ] compare nip ] if ;
 
 : sequence= ( seq1 seq2 -- ? )
-    2dup [ length ] bi@ dupd =
+    2dup 2length dupd =
     [ -rot mismatch-unsafe not ] [ 3drop f ] if ; inline
 
 ERROR: assert-sequence got expected ;
@@ -1040,10 +1040,10 @@ PRIVATE>
 : pad-tail ( seq n elt -- padded )
     [ append ] padding ;
 
-: shorter? ( seq1 seq2 -- ? ) [ length ] bi@ < ; inline
-: longer? ( seq1 seq2 -- ? ) [ length ] bi@ > ; inline
-: shorter ( seq1 seq2 -- seq ) [ [ length ] bi@ <= ] 2keep ? ; inline
-: longer ( seq1 seq2 -- seq ) [ [ length ] bi@ >= ] 2keep ? ; inline
+: shorter? ( seq1 seq2 -- ? ) 2length < ; inline
+: longer? ( seq1 seq2 -- ? ) 2length > ; inline
+: shorter ( seq1 seq2 -- seq ) [ 2length <= ] 2keep ? ; inline
+: longer ( seq1 seq2 -- seq ) [ 2length >= ] 2keep ? ; inline
 
 : head? ( seq begin -- ? )
     2dup shorter? [
@@ -1119,7 +1119,7 @@ PRIVATE>
     ] with all-integers? ; inline
 
 : subseq-index-from ( n seq subseq -- i/f )
-    [ [ length ] bi@ - 1 + ] 2keep
+    [ 2length - 1 + ] 2keep
     '[ _ _ subseq-starts-at? ] find-integer-from ; inline
 
 : subseq-index ( seq subseq -- i/f ) [ 0 ] 2dip subseq-index-from ; inline

diff --git a/extra/benchmark/benchmark-tests.factor b/extra/benchmark/benchmark-tests.factor
index 2ceb15ec5b4020d6485ac089711f16745f58f517..45ea9a7cfdfb161c0a2fdff536072994eedc8306 100644 (file)
--- a/extra/benchmark/benchmark-tests.factor
+++ b/extra/benchmark/benchmark-tests.factor
@@ -13,5 +13,5 @@ MAIN: dummy-benchmark
 
 { 0 1 } [
     { "benchmark.tests" } [ drop "hello" throw ] run-benchmarks
-    [ length ] bi@
+    2length
 ] unit-test

diff --git a/extra/benchmark/completion/completion.factor b/extra/benchmark/completion/completion.factor
index 9f73c72203423e82b8890ddc2f0c9e83c3cf0967..6a01e32b1c31e00f34e812258907b20a86f4ee2f 100644 (file)
--- a/extra/benchmark/completion/completion.factor
+++ b/extra/benchmark/completion/completion.factor
@@ -10,6 +10,6 @@ IN: benchmark.completion
             remove-nth remove-nth! change-nth
         }
     ] replicate concat [ named completions ] keep
-    [ length ] bi@ assert= ;
+    2length assert= ;
 
 MAIN: completion-benchmark

diff --git a/extra/semantic-versioning/semantic-versioning.factor b/extra/semantic-versioning/semantic-versioning.factor
new file mode 100644 (file)
index 0000000..6576e04
--- /dev/null
+++ b/extra/semantic-versioning/semantic-versioning.factor
@@ -0,0 +1,44 @@
+! Copyright (C) 2010 Maximilian Lupke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays ascii kernel math math.order math.parser sequences
+sorting.human splitting ;
+IN: semantic-versioning
+
+<PRIVATE
+
+: number<=> ( obj1 obj2 -- <=> )
+    [ [ zero? ] trim-tail-slice ] bi@ <=> ;
+
+: pre-release<=> ( obj1 obj2 -- <=> )
+    2dup [ empty? ] either?
+    [ 2length >=< ] [ human<=> ] if ;
+
+PRIVATE>
+
+: split-version ( string -- array )
+    "+" split1 [
+        dup [ [ digit? not ] [ CHAR: . = not ] bi and ] find [
+            [ cut ] [ CHAR: - = [ rest [ f ] when-empty ] when ] bi*
+        ] [ drop f ] if*
+        [ "." split [ string>number 0 or ] map 3 0 pad-tail ] dip
+    ] dip 3array ;
+
+: version<=> ( version1 version2 -- <=> )
+    [ split-version ] bi@
+    2dup [ first ] bi@ number<=> dup +eq+ =
+    [ drop [ second ] bi@ pre-release<=> ] [ 2nip ] if ;
+
+: version< ( version1 version2 -- ? )
+    version<=> +lt+ eq? ;
+
+: version<= ( version1 version2 -- ? )
+    version<=> { +lt+ +eq+ } member-eq? ;
+
+: version= ( version1 version2 -- ? )
+    version<=> +eq+ eq? ;
+
+: version>= ( version1 version2 -- ? )
+    version<=> { +gt+ +eq+ } member-eq? ;
+
+: version> ( version1 version2 -- ? )
+    version<=> +gt+ eq? ;

diff --git a/extra/smalltalk/compiler/compiler-tests.factor b/extra/smalltalk/compiler/compiler-tests.factor
index 8868fdb3fa8acdc95dbfc01e16057fbf363e4e99..40adbc8dc9b534dea0dd4e6c889d3e2d8ff9e36b 100644 (file)
--- a/extra/smalltalk/compiler/compiler-tests.factor
+++ b/extra/smalltalk/compiler/compiler-tests.factor
@@ -10,7 +10,7 @@ IN: smalltalk.compiler.tests
     ] with-compilation-unit ;
 
 : test-inference ( ast -- in# out# )
-    test-compilation infer [ in>> ] [ out>> ] bi [ length ] bi@ ;
+    test-compilation infer [ in>> ] [ out>> ] bi 2length ;
 
 { 2 1 } [
     T{ ast-block f

diff --git a/extra/sorting/extras/extras-tests.factor b/extra/sorting/extras/extras-tests.factor
index 78dadb6fe12578f772af80dea47645cff119766b..e74179ffd5c67dadbed1d3572113b3ef7d376e38 100644 (file)
--- a/extra/sorting/extras/extras-tests.factor
+++ b/extra/sorting/extras/extras-tests.factor
@@ -4,7 +4,7 @@ IN: sorting.extras
 
 { { 0 2 1 } } [ { 10 30 20 } [ <=> ] argsort ] unit-test
 { { 2 0 1 } } [
-    { "hello" "goodbye" "yo" } [ [ length ] bi@ <=> ] argsort
+    { "hello" "goodbye" "yo" } [ 2length <=> ] argsort
 ] unit-test
 
 { { "blue" "green" "purple" } } [

diff --git a/extra/tensors/tensors.factor b/extra/tensors/tensors.factor
index 90d76e647ea4a4a48da15e9d52339a53dac0603d..e7ad6f7381d8a172e8f1691a4208d88515379ff2 100644 (file)
--- a/extra/tensors/tensors.factor
+++ b/extra/tensors/tensors.factor
@@ -177,7 +177,7 @@ syntax:M: tensor like
         ] [
             [ >tensor ] dip
         ] if
-        2dup [ length ] bi@ = [ shape>> reshape ] [ drop ] if
+        2dup 2length = [ shape>> reshape ] [ drop ] if
     ] if ;
 
 syntax:M: tensor clone-like
@@ -185,7 +185,7 @@ syntax:M: tensor clone-like
     over tensor?
     [ drop clone ] [
         [ >tensor ] dip
-        2dup [ length ] bi@ = [ shape>> reshape ] [ drop ] if
+        2dup 2length = [ shape>> reshape ] [ drop ] if
     ] if ;
 
 INSTANCE: tensor sequence

diff --git a/extra/terminfo/terminfo.factor b/extra/terminfo/terminfo.factor
index 1fc172c4f735fda992a7cc942dc560d533129e1c..ed6958dfdbf0514872b60740380dc7ad7876e226 100644 (file)
--- a/extra/terminfo/terminfo.factor
+++ b/extra/terminfo/terminfo.factor
@@ -248,7 +248,7 @@ CONSTANT: string-names {
 }
 
 : zip-names ( seq names -- assoc )
-    swap 2dup [ length ] bi@ - f <repetition> append zip ;
+    swap 2dup 2length - f <repetition> append zip ;
 
 PRIVATE>