From 4e72d80256c7b631849698b9eea33cabe0586754 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 21 Jul 2012 10:22:44 -0700 Subject: [PATCH] Using "same?" in more places. --- basis/bit-sets/bit-sets.factor | 2 +- basis/bootstrap/image/image.factor | 4 ++-- basis/calendar/calendar-docs.factor | 2 +- basis/calendar/calendar.factor | 4 ++-- basis/calendar/format/format.factor | 2 +- basis/classes/struct/struct-tests.factor | 2 +- basis/classes/struct/struct.factor | 2 +- basis/cocoa/plists/plists-tests.factor | 4 ++-- basis/compiler/cfg/alias-analysis/alias-analysis.factor | 2 +- basis/compiler/cfg/dependence/dependence.factor | 4 ++-- basis/compiler/cfg/linear-scan/resolve/resolve.factor | 2 +- basis/compiler/tree/propagation/info/info.factor | 6 +++--- basis/concurrency/messaging/messaging.factor | 2 +- basis/dlists/dlists.factor | 2 +- basis/furnace/auth/providers/couchdb/couchdb.factor | 4 ++-- basis/furnace/utilities/utilities.factor | 2 +- basis/hashtables/wrapped/wrapped.factor | 2 +- basis/http/client/client-tests.factor | 2 +- basis/http/server/server-tests.factor | 2 +- basis/inverse/inverse.factor | 2 +- basis/io/directories/search/search-tests.factor | 2 +- basis/libc/libc.factor | 2 +- basis/match/match.factor | 2 +- basis/peg/peg.factor | 2 +- basis/persistent/hashtables/hashtables-tests.factor | 2 +- basis/sequences/product/product.factor | 2 +- basis/splitting/monotonic/monotonic-tests.factor | 6 +++--- basis/stack-checker/inlining/inlining.factor | 2 +- basis/tools/profiler/sampling/sampling.factor | 2 +- basis/ui/backend/windows/windows.factor | 2 +- basis/ui/gadgets/buttons/buttons.factor | 2 +- basis/unicode/collation/collation.factor | 2 +- basis/windows/ole32/ole32.factor | 2 +- basis/wrap/words/words.factor | 2 +- core/alien/alien.factor | 2 +- core/effects/effects.factor | 8 ++++---- core/generic/parser/parser.factor | 4 ++-- core/io/pathnames/pathnames-tests.factor | 8 ++++---- core/lexer/lexer.factor | 2 +- core/math/math.factor | 2 +- core/quotations/quotations.factor | 2 +- core/sequences/sequences-tests.factor | 6 +++--- core/sequences/sequences.factor | 2 +- extra/decimals/decimals.factor | 4 ++-- extra/graphviz/graphviz-docs.factor | 2 +- extra/images/atlas/atlas.factor | 6 +++--- extra/io/files/trash/unix/unix.factor | 2 +- extra/llvm/types/types-tests.factor | 6 +++--- extra/math/blas/vectors/vectors.factor | 2 +- extra/math/extras/extras.factor | 2 +- extra/path-finding/path-finding-tests.factor | 2 +- extra/project-euler/common/common.factor | 2 +- extra/quadtrees/quadtrees.factor | 6 +++--- extra/sequences/extras/extras-tests.factor | 2 +- extra/ui/render/test/test.factor | 2 +- extra/units/units.factor | 2 +- unmaintained/adsoda/adsoda.factor | 2 +- unmaintained/alien/inline/syntax/syntax-tests.factor | 2 +- unmaintained/dns/server/server.factor | 2 +- unmaintained/semantic-db/semantic-db.factor | 2 +- unmaintained/sudokus/sudokus.factor | 2 +- 61 files changed, 86 insertions(+), 86 deletions(-) diff --git a/basis/bit-sets/bit-sets.factor b/basis/bit-sets/bit-sets.factor index 9720125621..f0d366e7ed 100644 --- a/basis/bit-sets/bit-sets.factor +++ b/basis/bit-sets/bit-sets.factor @@ -75,7 +75,7 @@ M: bit-set members : bit-set-like ( set bit-set -- bit-set' ) ! Throws an error if there are keys that can't be put ! in the bit set - over bit-set? [ 2dup [ table>> length ] bi@ = ] [ f ] if + over bit-set? [ 2dup [ table>> length ] same? ] [ f ] if [ drop ] [ [ members ] dip table>> length [ [ adjoin ] curry each ] keep diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 9633c96679..8ade58998f 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -48,7 +48,7 @@ M: eql-wrapper hashcode* obj>> hashcode* ; GENERIC: (eql?) ( obj1 obj2 -- ? ) : eql? ( obj1 obj2 -- ? ) - { [ [ class-of ] bi@ = ] [ (eql?) ] } 2&& ; + { [ [ class-of ] same? ] [ (eql?) ] } 2&& ; M: fixnum (eql?) eq? ; @@ -56,7 +56,7 @@ M: bignum (eql?) = ; M: float (eql?) fp-bitwise= ; -M: sequence (eql?) 2dup [ length ] bi@ = [ [ eql? ] 2all? ] [ 2drop f ] if ; +M: sequence (eql?) 2dup [ length ] same? [ [ eql? ] 2all? ] [ 2drop f ] if ; M: object (eql?) = ; diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index cb5ce20376..a2549d4438 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -323,7 +323,7 @@ HELP: >local-time { $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." } { $examples { $example "USING: accessors calendar kernel prettyprint ;" - "now gmt >local-time [ gmt-offset>> ] bi@ = ." + "now gmt >local-time [ gmt-offset>> ] same? ." "t" } } ; diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 802e3ae10e..45644b035c 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -323,7 +323,7 @@ M: timestamp <=> ( ts1 ts2 -- n ) [ >gmt tuple-slots ] compare ; : same-day? ( ts1 ts2 -- ? ) - [ >gmt >date< ] bi@ = ; + [ >gmt >date< ] same? ; : (time-) ( timestamp timestamp -- n ) [ >gmt ] bi@ @@ -463,7 +463,7 @@ M: timestamp day-name day-of-week day-names nth ; :: nth-day-this-month ( timestamp n day -- new-timestamp ) timestamp beginning-of-month day day-this-week - dup timestamp [ month>> ] bi@ = [ 1 weeks time+ ] unless + dup timestamp [ month>> ] same? [ 1 weeks time+ ] unless n 1 - [ weeks time+ ] unless-zero ; : last-day-this-month ( timestamp day -- new-timestamp ) diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index 48c0ce6ed9..2d85632585 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -292,7 +292,7 @@ TYPED: timestamp>ymdhms ( timestamp: timestamp -- str ) { MONTH " " DD " " [ - dup now [ year>> ] bi@ = + dup now [ year>> ] same? [ [ hh ":" write ] [ mm ] bi ] [ YYYYY ] if ] } formatted diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 45373a96ac..dba07661ad 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -267,7 +267,7 @@ STRUCT: struct-test-equality-2 [ struct-test-equality-1 5 >>x struct-test-equality-1 malloc-struct &free 5 >>x - [ hashcode ] bi@ = + [ hashcode ] same? ] with-destructors ] unit-test diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 498350afbf..3ca6bf05a0 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -52,7 +52,7 @@ M: struct >c-ptr M: struct equal? over struct? [ - 2dup [ class-of ] bi@ = [ + 2dup [ class-of ] same? [ 2dup [ >c-ptr ] both? [ [ >c-ptr ] [ binary-object ] bi* memory= ] [ [ >c-ptr not ] both? ] diff --git a/basis/cocoa/plists/plists-tests.factor b/basis/cocoa/plists/plists-tests.factor index e5d7dfd239..dab09e0c80 100644 --- a/basis/cocoa/plists/plists-tests.factor +++ b/basis/cocoa/plists/plists-tests.factor @@ -15,13 +15,13 @@ IN: cocoa.plists.tests H{ { "DeviceUsagePage" 1 } { "DeviceUsage" 5 } } H{ { "DeviceUsagePage" 1 } { "DeviceUsage" 6 } } } [ >cf &CFRelease ] [ >cf &CFRelease ] bi - [ plist> ] bi@ = + [ plist> ] same? ] unit-test [ t ] [ { "DeviceUsagePage" 1 } [ >cf &CFRelease ] [ >cf &CFRelease ] bi - [ plist> ] bi@ = + [ plist> ] same? ] unit-test [ V{ "DeviceUsagePage" "Yes" } ] [ diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 14821031f2..2cfeb51014 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -275,7 +275,7 @@ M: ##copy analyze-aliases : useless-compare? ( insn -- ? ) { [ cc>> cc= eq? ] - [ [ src1>> ] [ src2>> ] bi [ resolve vreg>ac ] bi@ = not ] + [ [ src1>> ] [ src2>> ] bi [ resolve vreg>ac ] same? not ] } 1&& ; inline M: ##compare analyze-aliases diff --git a/basis/compiler/cfg/dependence/dependence.factor b/basis/compiler/cfg/dependence/dependence.factor index 4005063e34..d15351e770 100644 --- a/basis/compiler/cfg/dependence/dependence.factor +++ b/basis/compiler/cfg/dependence/dependence.factor @@ -24,7 +24,7 @@ TUPLE: node children parent registers parent-index ; -M: node equal? over node? [ [ number>> ] bi@ = ] [ 2drop f ] if ; +M: node equal? over node? [ [ number>> ] same? ] [ 2drop f ] if ; M: node hashcode* nip number>> ; @@ -145,7 +145,7 @@ ERROR: node-missing-children trees nodes ; : verify-children ( trees -- trees ) dup [ flatten-tree ] map concat nodes get - { [ [ length ] bi@ = ] [ set= ] } 2&& + { [ [ length ] same? ] [ set= ] } 2&& [ nodes get node-missing-children ] unless ; : verify-trees ( trees -- trees ) diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index 7361fc8f10..68c43dfc87 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -27,7 +27,7 @@ TUPLE: location M: location equal? over location? [ - { [ [ reg>> ] bi@ = ] [ [ reg-class>> ] bi@ = ] } 2&& + { [ [ reg>> ] same? ] [ [ reg-class>> ] same? ] } 2&& ] [ 2drop f ] if ; M: location hashcode* diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 9056a7fb77..1186e31eb2 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -19,7 +19,7 @@ M: object eql? eq? ; M: fixnum eql? eq? ; M: bignum eql? over bignum? [ = ] [ 2drop f ] if ; M: ratio eql? over ratio? [ = ] [ 2drop f ] if ; -M: float eql? over float? [ [ double>bits ] bi@ = ] [ 2drop f ] if ; +M: float eql? over float? [ [ double>bits ] same? ] [ 2drop f ] if ; M: complex eql? over complex? [ = ] [ 2drop f ] if ; ! Value info represents a set of objects. Don't mutate value infos @@ -200,7 +200,7 @@ DEFER: (value-info-intersect) { [ dup not ] [ drop ] } { [ over not ] [ nip ] } [ - 2dup [ length ] bi@ = + 2dup [ length ] same? [ [ intersect-slot ] 2map ] [ 2drop f ] if ] } cond ; @@ -240,7 +240,7 @@ DEFER: (value-info-union) : union-slots ( info1 info2 -- slots ) [ slots>> ] bi@ - 2dup [ length ] bi@ = + 2dup [ length ] same? [ [ union-slot ] 2map ] [ 2drop f ] if ; : (value-info-union) ( info1 info2 -- info ) diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index 3f55b0969b..c5140e7506 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -47,7 +47,7 @@ TUPLE: reply data tag ; tag>> \ reply boa ; : synchronous-reply? ( response synchronous -- ? ) - over reply? [ [ tag>> ] bi@ = ] [ 2drop f ] if ; + over reply? [ [ tag>> ] same? ] [ 2drop f ] if ; ERROR: cannot-send-synchronous-to-self message thread ; diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor index e767a9923e..297e5a5c25 100644 --- a/basis/dlists/dlists.factor +++ b/basis/dlists/dlists.factor @@ -38,7 +38,7 @@ M: dlist deque-empty? front>> not ; inline M: dlist equal? over dlist? [ [ front>> ] bi@ - [ 2dup { [ and ] [ [ obj>> ] bi@ = ] } 2&& ] + [ 2dup { [ and ] [ [ obj>> ] same? ] } 2&& ] [ [ next>> ] bi@ ] while or not ] [ diff --git a/basis/furnace/auth/providers/couchdb/couchdb.factor b/basis/furnace/auth/providers/couchdb/couchdb.factor index 841cf16dc2..8df62df9b2 100644 --- a/basis/furnace/auth/providers/couchdb/couchdb.factor +++ b/basis/furnace/auth/providers/couchdb/couchdb.factor @@ -182,14 +182,14 @@ TUPLE: couchdb-auth-provider ! (This word is called by the 'update-user' method.) : check-update ( old new -- ? ) [ - 2dup [ "email" swap at ] bi@ = not [ + 2dup [ "email" swap at ] same? not [ [ "email" swap at ] bi@ [ drop "email" reservation-id unreserve-from-id ] [ nip "email" reserve ] 2bi ] [ 2drop t ] if ] [ - 2dup [ "username" swap at ] bi@ = not [ + 2dup [ "username" swap at ] same? not [ [ "username" swap at ] bi@ [ drop "username" reservation-id unreserve-from-id ] [ nip "username" reserve ] diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 5d35d6f94a..9a82490482 100644 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -108,7 +108,7 @@ CONSTANT: nested-forms-key "__n" [ host>> ] [ port>> remap-port ] tri 3array - ] bi@ = + ] same? ] when ; : cookie-client-state ( key request -- value/f ) diff --git a/basis/hashtables/wrapped/wrapped.factor b/basis/hashtables/wrapped/wrapped.factor index 82d76c44bd..d2ed473ac1 100644 --- a/basis/hashtables/wrapped/wrapped.factor +++ b/basis/hashtables/wrapped/wrapped.factor @@ -40,7 +40,7 @@ M: wrapped-hashtable >alist underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ; M: wrapped-hashtable equal? - over wrapped-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ; + over wrapped-hashtable? [ [ underlying>> ] same? ] [ 2drop f ] if ; INSTANCE: wrapped-hashtable assoc diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor index 0b2120d31a..d2d4fb5abe 100644 --- a/basis/http/client/client-tests.factor +++ b/basis/http/client/client-tests.factor @@ -51,5 +51,5 @@ IN: http.client.tests "date: Wed, 12 Oct 2011 18:57:49 GMT" "server: Factor http.server" } [ "\n" join ] [ "\r\n" join ] bi - [ [ read-response ] with-string-reader ] bi@ = + [ [ read-response ] with-string-reader ] same? ] unit-test diff --git a/basis/http/server/server-tests.factor b/basis/http/server/server-tests.factor index 149f519471..da43c0e0bc 100644 --- a/basis/http/server/server-tests.factor +++ b/basis/http/server/server-tests.factor @@ -41,7 +41,7 @@ IN: http.server.tests "host: 127.0.0.1:55532" "user-agent: Factor http.client" } [ "\n" join ] [ "\r\n" join ] bi - [ [ read-request ] with-string-reader ] bi@ = + [ [ read-request ] with-string-reader ] same? ] unit-test ! RFC 2616: Section 4.1 diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 3e1f88abe2..9a5b32c65a 100644 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -225,7 +225,7 @@ DEFER: __ \ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse : assure-same-class ( obj1 obj2 -- ) - [ class-of ] bi@ = assure ; inline + [ class-of ] same? assure ; inline \ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ inputsequence ] ] define-pop-inverse diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index db4b58c4fd..28585d5f41 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -8,7 +8,7 @@ IN: io.directories.search.tests [ 10 [ "io.paths.test" "gogogo" make-unique-file ] replicate current-temporary-directory get [ ] find-all-files - ] cleanup-unique-directory [ natural-sort ] bi@ = + ] cleanup-unique-directory [ natural-sort ] same? ] unit-test [ f ] [ diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index e9693aa2df..6b025e957a 100644 --- a/basis/libc/libc.factor +++ b/basis/libc/libc.factor @@ -43,7 +43,7 @@ TUPLE: malloc-ptr value continuation ; M: malloc-ptr hashcode* value>> hashcode* ; M: malloc-ptr equal? - over malloc-ptr? [ [ value>> ] bi@ = ] [ 2drop f ] if ; + over malloc-ptr? [ [ value>> ] same? ] [ 2drop f ] if ; : ( value -- malloc-ptr ) malloc-ptr new swap >>value ; diff --git a/basis/match/match.factor b/basis/match/match.factor index f009aa2ccb..bd1bf9e930 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -32,7 +32,7 @@ SYNTAX: MATCH-VARS: ! vars ... { [ 2dup = ] [ 2drop t ] } { [ 2dup [ _ eq? ] either? ] [ 2drop t ] } { [ 2dup [ sequence? ] both? ] [ - 2dup [ length ] bi@ = + 2dup [ length ] same? [ [ (match) ] 2all? ] [ 2drop f ] if ] } { [ 2dup [ tuple? ] both? ] [ [ tuple>array ] bi@ [ (match) ] 2all? ] } diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 5582d93cdf..23a929a9ee 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -12,7 +12,7 @@ TUPLE: parse-result remaining ast ; TUPLE: parse-error position messages ; TUPLE: parser peg compiled id ; -M: parser equal? { [ [ class-of ] bi@ = ] [ [ id>> ] bi@ = ] } 2&& ; +M: parser equal? { [ [ class-of ] same? ] [ [ id>> ] same? ] } 2&& ; M: parser hashcode* id>> hashcode* ; C: parse-result diff --git a/basis/persistent/hashtables/hashtables-tests.factor b/basis/persistent/hashtables/hashtables-tests.factor index 482367ad9c..fd259593c4 100644 --- a/basis/persistent/hashtables/hashtables-tests.factor +++ b/basis/persistent/hashtables/hashtables-tests.factor @@ -91,7 +91,7 @@ M: hash-0-b hashcode* 2drop 0 ; bi ; : ok? ( assoc1 assoc2 -- ? ) - [ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ; + [ assoc= ] [ [ assoc-size ] same? ] 2bi and ; : test-persistent-hashtables-1 ( n -- ? ) random-assocs ok? ; diff --git a/basis/sequences/product/product.factor b/basis/sequences/product/product.factor index a3067f09d5..1c193a1461 100644 --- a/basis/sequences/product/product.factor +++ b/basis/sequences/product/product.factor @@ -42,7 +42,7 @@ M: product-sequence length lengths>> product ; [ length 0 ] [ [ length ] map ] bi ; : end-product-iter? ( ns lengths -- ? ) - [ last ] bi@ = ; + [ last ] same? ; PRIVATE> diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor index 77dccfb434..64d1ac0ee6 100644 --- a/basis/splitting/monotonic/monotonic-tests.factor +++ b/basis/splitting/monotonic/monotonic-tests.factor @@ -58,8 +58,8 @@ USING: tools.test math arrays kernel sequences ; [ { { 2 2 } { 3 3 3 3 } { 4 } { 5 } } ] [ - { 2 2 3 3 3 3 4 5 } - [ [ odd? ] bi@ = ] slice monotonic-slice + { 2 2 3 3 3 3 4 5 } + [ [ odd? ] same? ] slice monotonic-slice [ >array ] map ] unit-test @@ -67,6 +67,6 @@ USING: tools.test math arrays kernel sequences ; { { 1 1 1 } { 2 2 2 2 } { 3 3 } } ] [ { 1 1 1 2 2 2 2 3 3 } - [ [ odd? ] bi@ = ] slice monotonic-slice + [ [ odd? ] same? ] slice monotonic-slice [ >array ] map ] unit-test diff --git a/basis/stack-checker/inlining/inlining.factor b/basis/stack-checker/inlining/inlining.factor index eec44a238f..654e2b5c8e 100644 --- a/basis/stack-checker/inlining/inlining.factor +++ b/basis/stack-checker/inlining/inlining.factor @@ -127,7 +127,7 @@ M: declared-effect (undeclared-known) known>> (undeclared-known) ; : check-call-site-stack ( label -- ) [ ] [ call-site-stack ] [ trimmed-enter-out ] tri - [ dup undeclared-known [ [ undeclared-known ] bi@ = ] [ 2drop t ] if ] 2all? + [ dup undeclared-known [ [ undeclared-known ] same? ] [ 2drop t ] if ] 2all? [ drop ] [ word>> inconsistent-recursive-call-error inference-error ] if ; : check-call ( label -- ) diff --git a/basis/tools/profiler/sampling/sampling.factor b/basis/tools/profiler/sampling/sampling.factor index 43cf5c3325..750f634f79 100644 --- a/basis/tools/profiler/sampling/sampling.factor +++ b/basis/tools/profiler/sampling/sampling.factor @@ -147,7 +147,7 @@ PRIVATE> per-word-samples [ f 0 ] assoc-map ; : redundant-flat-node? ( child-node root-node -- ? ) - [ total-time>> ] bi@ = ; + [ total-time>> ] same? ; : trim-flat ( root-node -- root-node' ) dup '[ [ nip _ redundant-flat-node? not ] assoc-filter ] change-children ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index c3ff0b50f2..e39d421b0c 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -859,7 +859,7 @@ M: windows-ui-backend (set-fullscreen) ( ? world -- ) M: windows-ui-backend (fullscreen?) ( world -- ? ) handle>> hWnd>> [ hwnd>RECT ] [ fullscreen-RECT ] bi - [ get-RECT-dimensions 2array 2nip ] bi@ = ; + [ get-RECT-dimensions 2array 2nip ] same? ; M: windows-ui-backend ui-backend-available? t ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 1bcd8a1654..dbf14f485f 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -218,7 +218,7 @@ TUPLE: radio-control < button value ; align-left ; inline M: radio-control model-changed - 2dup [ value>> ] bi@ = >>selected? relayout-1 drop ; + 2dup [ value>> ] same? >>selected? relayout-1 drop ; :: ( model assoc parent quot: ( value model label -- gadget ) -- parent ) parent assoc [ model swap quot call add-gadget ] assoc-each ; inline diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index ba89ccecad..b66c9be792 100644 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -134,7 +134,7 @@ PRIVATE> [ [ collation-key ] dip [ [ 0 = not ] trim-tail but-last ] times - ] curry bi@ = ; + ] curry same? ; PRIVATE> : primary= ( str1 str2 -- ? ) diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index abf255d4d0..e284108c67 100644 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -129,7 +129,7 @@ TUPLE: ole32-error code message ; f OleInitialize check-ole32-error ; : guid= ( a b -- ? ) - [ 16 memory>byte-array ] bi@ = ; + [ 16 memory>byte-array ] same? ; CONSTANT: GUID-STRING-LENGTH $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ] diff --git a/basis/wrap/words/words.factor b/basis/wrap/words/words.factor index 303876d916..90113c289e 100644 --- a/basis/wrap/words/words.factor +++ b/basis/wrap/words/words.factor @@ -18,7 +18,7 @@ C: word [ ?first ] [ ?second ] bi ; : split-words ( seq -- half-elements ) - [ [ break?>> ] bi@ = ] monotonic-split ; + [ [ break?>> ] same? ] monotonic-split ; : ?first-break ( seq -- newseq f/element ) dup first first break?>> diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 83c8fb41a6..6440181622 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -54,7 +54,7 @@ M: alien equal? 2dup [ expired? ] either? [ [ expired? ] both? ] [ - [ alien-address ] bi@ = + [ alien-address ] same? ] if ] [ 2drop f diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 650e6b79c5..1ac78fcae8 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -39,14 +39,14 @@ TUPLE: effect { [ 2dup [ bivariable-effect? ] either? ] [ f ] } { [ 2dup [ variable-effect? ] [ variable-effect? not ] bi* and ] [ f ] } { [ 2dup [ in>> length ] bi@ > ] [ f ] } - { [ 2dup [ effect-height ] bi@ = not ] [ f ] } + { [ 2dup [ effect-height ] same? not ] [ f ] } [ t ] } cond 2nip ; inline : effect= ( effect1 effect2 -- ? ) - [ [ in>> length ] bi@ = ] - [ [ out>> length ] bi@ = ] - [ [ terminated?>> ] bi@ = ] + [ [ in>> length ] same? ] + [ [ out>> length ] same? ] + [ [ terminated?>> ] same? ] 2tri and and ; GENERIC: effect>string ( obj -- str ) diff --git a/core/generic/parser/parser.factor b/core/generic/parser/parser.factor index fe8d953793..dcb0f665db 100644 --- a/core/generic/parser/parser.factor +++ b/core/generic/parser/parser.factor @@ -29,10 +29,10 @@ SYMBOL: current-method "method-generic" word-prop "declared-effect" word-prop ; : method-effect= ( method-effect generic-effect -- ? ) - [ [ in>> length ] bi@ = ] + [ [ in>> length ] same? ] [ over terminated?>> - [ 2drop t ] [ [ out>> length ] bi@ = ] if + [ 2drop t ] [ [ out>> length ] same? ] if ] 2bi and ; ERROR: bad-method-effect ; diff --git a/core/io/pathnames/pathnames-tests.factor b/core/io/pathnames/pathnames-tests.factor index 2d352848ce..c609508865 100644 --- a/core/io/pathnames/pathnames-tests.factor +++ b/core/io/pathnames/pathnames-tests.factor @@ -74,12 +74,12 @@ IN: io.pathnames.tests ! Testing ~ special pathname [ t ] [ os windows? "~\\" "~/" ? absolute-path home = ] unit-test -[ t ] [ "~/" home [ normalize-path ] bi@ = ] unit-test +[ t ] [ "~/" home [ normalize-path ] same? ] unit-test [ t ] [ "~" absolute-path home = ] unit-test -[ t ] [ "~" home [ normalize-path ] bi@ = ] unit-test +[ t ] [ "~" home [ normalize-path ] same? ] unit-test -[ t ] [ "~" home [ "foo" append-path ] bi@ [ normalize-path ] bi@ = ] unit-test -[ t ] [ os windows? "~\\~/" "~/~/" ? "~" "~" append-path [ path-components ] bi@ = ] unit-test +[ t ] [ "~" home [ "foo" append-path ] bi@ [ normalize-path ] same? ] unit-test +[ t ] [ os windows? "~\\~/" "~/~/" ? "~" "~" append-path [ path-components ] same? ] unit-test diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor index 123f2a5a71..ea156efc00 100644 --- a/core/lexer/lexer.factor +++ b/core/lexer/lexer.factor @@ -153,7 +153,7 @@ M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ; simple-lexer-dump ; : parsing-word-lexer-dump ( error parsing-word -- ) - 2dup [ line>> ] bi@ = + 2dup [ line>> ] same? [ drop simple-lexer-dump ] [ (parsing-word-lexer-dump) ] if ; diff --git a/core/math/math.factor b/core/math/math.factor index 150f508cdb..1810cc0ee2 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -96,7 +96,7 @@ TUPLE: complex { real real read-only } { imaginary real read-only } ; UNION: number real complex ; -: fp-bitwise= ( x y -- ? ) [ double>bits ] bi@ = ; inline +: fp-bitwise= ( x y -- ? ) [ double>bits ] same? ; inline GENERIC: fp-special? ( x -- ? ) GENERIC: fp-nan? ( x -- ? ) diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor index 2af94159f8..9b85289bd6 100644 --- a/core/quotations/quotations.factor +++ b/core/quotations/quotations.factor @@ -22,7 +22,7 @@ M: curry call uncurry call ; M: compose call uncompose [ call ] dip call ; M: wrapper equal? - over wrapper? [ [ wrapped>> ] bi@ = ] [ 2drop f ] if ; + over wrapper? [ [ wrapped>> ] same? ] [ 2drop f ] if ; UNION: callable quotation curry compose ; diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 9d560facbd..c1bc96c259 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -131,10 +131,10 @@ unit-test [ "xx" ] [ "blahxx" 2 tail* ] unit-test [ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice = ] unit-test -[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] bi@ = ] unit-test +[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] same? ] unit-test [ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* = ] unit-test -[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] bi@ = ] unit-test +[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] same? ] unit-test [ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test [ t ] [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test @@ -222,7 +222,7 @@ unit-test [ t ] [ "hi" SBUF" hi" = ] unit-test -[ t ] [ "hi" SBUF" hi" [ hashcode ] bi@ = ] unit-test +[ t ] [ "hi" SBUF" hi" [ hashcode ] same? ] unit-test [ -10 "hi" "bye" copy ] must-fail [ 10 "hi" "bye" copy ] must-fail diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 08a475001a..67e4440303 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -623,7 +623,7 @@ M: sequence <=> [ 2nth-unsafe <=> ] [ [ length ] compare nip ] if ; : sequence= ( seq1 seq2 -- ? ) - 2dup [ length ] bi@ = + 2dup [ length ] same? [ mismatch not ] [ 2drop f ] if ; inline ERROR: assert-sequence got expected ; diff --git a/extra/decimals/decimals.factor b/extra/decimals/decimals.factor index 3cd51abc98..a356e8a6e1 100644 --- a/extra/decimals/decimals.factor +++ b/extra/decimals/decimals.factor @@ -51,8 +51,8 @@ M: decimal equal? [ scale-decimals { - [ [ mantissa>> ] bi@ = ] - [ [ exponent>> ] bi@ = ] + [ [ mantissa>> ] same? ] + [ [ exponent>> ] same? ] } 2&& ] } 2&& ; diff --git a/extra/graphviz/graphviz-docs.factor b/extra/graphviz/graphviz-docs.factor index c05b2fc82c..19c7a49dfa 100644 --- a/extra/graphviz/graphviz-docs.factor +++ b/extra/graphviz/graphviz-docs.factor @@ -33,7 +33,7 @@ $nl "More generally, the following should always be the case:" { $example "USING: accessors graphviz kernel prettyprint ;" - " [ id>> ] bi@ = ." + " [ id>> ] same? ." "f" } } diff --git a/extra/images/atlas/atlas.factor b/extra/images/atlas/atlas.factor index db1f0c2caf..8da73585ad 100644 --- a/extra/images/atlas/atlas.factor +++ b/extra/images/atlas/atlas.factor @@ -51,9 +51,9 @@ ERROR: atlas-image-formats-dont-match images ; : atlas-image-format ( image-placements -- component-order component-type upside-down? ) [ image>> ] map dup unclip '[ _ - [ [ component-order>> ] bi@ = ] - [ [ component-type>> ] bi@ = ] - [ [ upside-down?>> ] bi@ = ] 2tri and and + [ [ component-order>> ] same? ] + [ [ component-type>> ] same? ] + [ [ upside-down?>> ] same? ] 2tri and and ] all? [ first [ component-order>> ] [ component-type>> ] [ upside-down?>> ] tri ] [ atlas-image-formats-dont-match ] if ; inline diff --git a/extra/io/files/trash/unix/unix.factor b/extra/io/files/trash/unix/unix.factor index f451891311..0d52ec6b27 100644 --- a/extra/io/files/trash/unix/unix.factor +++ b/extra/io/files/trash/unix/unix.factor @@ -15,7 +15,7 @@ IN: io.files.trash.unix : top-directory? ( path -- ? ) dup ".." append-path [ link-status ] bi@ - [ [ st_dev>> ] bi@ = not ] [ [ st_ino>> ] bi@ = ] 2bi or ; + [ [ st_dev>> ] same? not ] [ [ st_ino>> ] same? ] 2bi or ; : top-directory ( path -- path' ) [ dup top-directory? not ] [ ".." append-path ] while ; diff --git a/extra/llvm/types/types-tests.factor b/extra/llvm/types/types-tests.factor index d715fe97df..9422ce54aa 100644 --- a/extra/llvm/types/types-tests.factor +++ b/extra/llvm/types/types-tests.factor @@ -18,8 +18,8 @@ USING: kernel llvm.types sequences tools.test ; [ T{ struct f f { float TYPE: i32 (i32)* ; } t } ] [ TYPE: < { float, i32 (i32)* } > ; ] unit-test -[ t ] [ TYPE: i32 ; TYPE: i32 ; [ >tref ] bi@ = ] unit-test -[ t ] [ TYPE: i32 * ; TYPE: i32 * ; [ >tref ] bi@ = ] unit-test +[ t ] [ TYPE: i32 ; TYPE: i32 ; [ >tref ] same? ] unit-test +[ t ] [ TYPE: i32 * ; TYPE: i32 * ; [ >tref ] same? ] unit-test [ TYPE: i32 ; ] [ TYPE: i32 ; >tref tref> ] unit-test [ TYPE: float ; ] [ TYPE: float ; >tref tref> ] unit-test @@ -37,4 +37,4 @@ USING: kernel llvm.types sequences tools.test ; [ TYPE: < { i32, i32 } > ; ] [ TYPE: < { i32, i32 } > ; >tref tref> ] unit-test [ TYPE: i32 ( i32 ) ; ] [ TYPE: i32 ( i32 ) ; >tref tref> ] unit-test [ TYPE: \1* ; ] [ TYPE: \1* ; >tref tref> ] unit-test -[ TYPE: { i32, \2* } ; ] [ TYPE: { i32, \2* } ; >tref tref> ] unit-test \ No newline at end of file +[ TYPE: { i32, \2* } ; ] [ TYPE: { i32, \2* } ; >tref tref> ] unit-test diff --git a/extra/math/blas/vectors/vectors.factor b/extra/math/blas/vectors/vectors.factor index bd07cfb932..857d8d585e 100644 --- a/extra/math/blas/vectors/vectors.factor +++ b/extra/math/blas/vectors/vectors.factor @@ -111,7 +111,7 @@ PRIVATE> M: blas-vector-base equal? { - [ [ length ] bi@ = ] + [ [ length ] same? ] [ [ = ] 2all? ] } 2&& ; diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor index 812de63c47..77c301e6f5 100644 --- a/extra/math/extras/extras.factor +++ b/extra/math/extras/extras.factor @@ -60,7 +60,7 @@ PRIVATE> : mod' ( x y -- n ) [ mod ] keep over zero? [ drop ] [ - 2dup [ sgn ] bi@ = [ drop ] [ + ] if + 2dup [ sgn ] same? [ drop ] [ + ] if ] if ; PRIVATE> diff --git a/extra/path-finding/path-finding-tests.factor b/extra/path-finding/path-finding-tests.factor index 6c20104fe1..c81a3b9d7a 100644 --- a/extra/path-finding/path-finding-tests.factor +++ b/extra/path-finding/path-finding-tests.factor @@ -41,7 +41,7 @@ M: maze heuristic drop v- [ abs ] [ + ] map-reduce ; M: maze cost - drop 2dup [ first ] bi@ = [ [ second ] bi@ > 1 5 ? ] [ 2drop 2 ] if ; + drop 2dup [ first ] same? [ [ second ] bi@ > 1 5 ? ] [ 2drop 2 ] if ; : test1 ( to -- path considered ) { 1 1 } swap maze new [ find-path ] [ considered ] bi ; diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 33bd1fd408..f72a5b96af 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -118,7 +118,7 @@ PRIVATE> [ propagate dup ] map nip reverse swap suffix ; : permutations? ( n m -- ? ) - [ count-digits ] bi@ = ; + [ count-digits ] same? ; : sum-divisors ( n -- sum ) dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ; diff --git a/extra/quadtrees/quadtrees.factor b/extra/quadtrees/quadtrees.factor index ab0e9bda23..36524da583 100644 --- a/extra/quadtrees/quadtrees.factor +++ b/extra/quadtrees/quadtrees.factor @@ -160,14 +160,14 @@ DEFER: in-rect* : quadtree-size ( tree -- count ) dup leaf?>> [ leaf-size ] [ node-size ] if ; -: leaf= ( a b -- ? ) [ [ point>> ] [ value>> ] bi 2array ] bi@ = ; +: leaf= ( a b -- ? ) [ [ point>> ] [ value>> ] bi 2array ] same? ; -: node= ( a b -- ? ) [ {quadrants} ] bi@ = ; +: node= ( a b -- ? ) [ {quadrants} ] same? ; : (tree=) ( a b -- ? ) dup leaf?>> [ leaf= ] [ node= ] if ; : tree= ( a b -- ? ) - 2dup [ leaf?>> ] bi@ = [ (tree=) ] [ 2drop f ] if ; + 2dup [ leaf?>> ] same? [ (tree=) ] [ 2drop f ] if ; PRIVATE> diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 52aff0a307..81f1eec879 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -78,5 +78,5 @@ IN: sequences.extras.tests { { } } [ "ABC" [ ] { } trim-as ] unit-test { "ABC" } [ { 32 65 66 67 32 } [ blank? ] "" trim-as ] unit-test -{ t } [ "ABC" dup [ blank? ] ?trim [ identity-hashcode ] bi@ = ] unit-test +{ t } [ "ABC" dup [ blank? ] ?trim [ identity-hashcode ] same? ] unit-test { "ABC" } [ " ABC " [ blank? ] ?trim ] unit-test diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor index ca7c60e4d6..209230e451 100644 --- a/extra/ui/render/test/test.factor +++ b/extra/ui/render/test/test.factor @@ -27,7 +27,7 @@ SYMBOL: render-output [ 10 /i ] map ; : bitmap= ( bitmap1 bitmap2 -- ? ) - [ bitmap>> twiddle ] bi@ = ; + [ bitmap>> twiddle ] same? ; : check-rendering ( gadget -- ) screenshot diff --git a/extra/units/units.factor b/extra/units/units.factor index a293d79f78..90eea34215 100644 --- a/extra/units/units.factor +++ b/extra/units/units.factor @@ -36,7 +36,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; [ top>> ] [ bot>> ] bi ; : check-dimensions ( d d -- ) - [ dimensions 2array ] bi@ = + [ dimensions 2array ] same? [ dimensions-not-equal ] unless ; : 2values ( dim dim -- val val ) [ value>> ] bi@ ; diff --git a/unmaintained/adsoda/adsoda.factor b/unmaintained/adsoda/adsoda.factor index a89c4880e1..ed6dfe02c8 100644 --- a/unmaintained/adsoda/adsoda.factor +++ b/unmaintained/adsoda/adsoda.factor @@ -440,7 +440,7 @@ TUPLE: space name dimension solids ambient-color lights ; : get-silhouette ( solid -- silhouette ) silhouettes>> pv> swap nth ; -: solid= ( solid solid -- ? ) [ corners>> ] bi@ = ; +: solid= ( solid solid -- ? ) [ corners>> ] same? ; : space-apply ( space m quot -- space ) curry [ map ] curry [ dup solids>> ] dip diff --git a/unmaintained/alien/inline/syntax/syntax-tests.factor b/unmaintained/alien/inline/syntax/syntax-tests.factor index c49b2b5aae..4044e1605d 100644 --- a/unmaintained/alien/inline/syntax/syntax-tests.factor +++ b/unmaintained/alien/inline/syntax/syntax-tests.factor @@ -30,7 +30,7 @@ C-FUNCTION: int area ( rectangle c ) { 2 1 } [ add ] must-infer-as [ 5 ] [ 2 3 add ] unit-test -[ t ] [ "double" "bigfloat" [ resolve-typedef ] bi@ = ] unit-test +[ t ] [ "double" "bigfloat" [ resolve-typedef ] same? ] unit-test { 1 1 } [ smaller ] must-infer-as [ 1.0 ] [ 10 smaller ] unit-test diff --git a/unmaintained/dns/server/server.factor b/unmaintained/dns/server/server.factor index 66acb6f4b8..53d118608c 100644 --- a/unmaintained/dns/server/server.factor +++ b/unmaintained/dns/server/server.factor @@ -18,7 +18,7 @@ SYMBOL: records-var : {name-type-class} ( obj -- array ) [ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ; -: rr=query? ( obj obj -- ? ) [ {name-type-class} ] bi@ = ; +: rr=query? ( obj obj -- ? ) [ {name-type-class} ] same? ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/unmaintained/semantic-db/semantic-db.factor b/unmaintained/semantic-db/semantic-db.factor index e3d13108ad..2432dce420 100644 --- a/unmaintained/semantic-db/semantic-db.factor +++ b/unmaintained/semantic-db/semantic-db.factor @@ -22,7 +22,7 @@ node "node" : node-content ( node -- content ) dup content>> [ nip ] [ select-tuple content>> ] if* ; -: node= ( node node -- ? ) [ id>> ] bi@ = ; +: node= ( node node -- ? ) [ id>> ] same? ; ! TODO: get rid of arc id and write our own sql TUPLE: arc id subject object relation ; diff --git a/unmaintained/sudokus/sudokus.factor b/unmaintained/sudokus/sudokus.factor index c7bc6944fb..8944488019 100644 --- a/unmaintained/sudokus/sudokus.factor +++ b/unmaintained/sudokus/sudokus.factor @@ -8,7 +8,7 @@ IN: sudokus : row ( index -- row ) 1 + 9 / ceiling ; : col ( index -- col ) 9 mod 1 + ; : sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ; -: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ; +: near ( a pos -- ? ) { [ [ row ] same? ] [ [ col ] same? ] [ [ sq ] same? ] } 2|| ; : nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ; :: solutions ( puzzle random? -- solutions ) -- 2.34.1