Using "same?" in more places.

2012-07-21 10:22:44 -07:00 · 2012-07-21 10:22:44 -07:00 · 4e72d80256
parent 71cd7c5f81
commit 4e72d80256
61 changed files with 86 additions and 86 deletions
--- 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 <bit-set>
        [ [ adjoin ] curry each ] keep
--- 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?) = ;

--- 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"
    }
 } ;
--- 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< <date> ] bi@ = ;
+    [ >gmt >date< <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 )
--- 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
--- 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 <struct> 5 >>x
        struct-test-equality-1 malloc-struct &free 5 >>x
-        [ hashcode ] bi@ =
+        [ hashcode ] same?
    ] with-destructors
 ] unit-test

--- 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? ]
--- 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" } ] [
--- 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
--- 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 )
--- 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*
--- 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 )
--- 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 ;

--- 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
    ] [
--- 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 ]
--- 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 )
--- 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

--- 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
--- 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
--- 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 _ input<sequence ] ] define-pop-inverse
 \ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse
--- 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 ] [
--- 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 ;

 : <malloc-ptr> ( value -- malloc-ptr )
    malloc-ptr new swap >>value ;
--- 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? ] }
--- 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> parse-result
--- 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? ;
--- a/basis/sequences/product/product.factor
+++ b/basis/sequences/product/product.factor
@ -42,7 +42,7 @@ M: product-sequence length lengths>> product ;
    [ length 0 <array> ] [ [ length ] map ] bi ;

 : end-product-iter? ( ns lengths -- ? )
-    [ last ] bi@ = ;
+    [ last ] same? ;

 PRIVATE>

--- 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
--- 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 -- )
--- a/basis/tools/profiler/sampling/sampling.factor
+++ b/basis/tools/profiler/sampling/sampling.factor
@ -147,7 +147,7 @@ PRIVATE>
    per-word-samples [ f 0 <profile-node> ] 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 ;
--- 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 ;
--- 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 ;

 :: <radio-controls> ( model assoc parent quot: ( value model label -- gadget ) -- parent )
    parent assoc [ model swap quot call add-gadget ] assoc-each ; inline
--- 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 -- ? )
--- 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 ]
--- a/basis/wrap/words/words.factor
+++ b/basis/wrap/words/words.factor
@ -18,7 +18,7 @@ C: <word> 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?>>
--- 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
--- 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 )
--- 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 ;
--- 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


--- 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 ;

--- 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 -- ? )
--- 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 ;

--- 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" <reversed> SBUF" hi" <reversed> = ] unit-test

-[ t ] [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] bi@ = ] unit-test
+[ t ] [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] same? ] unit-test

 [ -10 "hi" "bye" copy ] must-fail
 [ 10 "hi" "bye" copy ] must-fail
--- 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 ;
--- 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&& ;
--- 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 ;"
-      "<anon> <anon> [ id>> ] bi@ = ."
+      "<anon> <anon> [ id>> ] same? ."
      "f"
    }
 }
--- 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
--- 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 ;
--- 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
+[ TYPE: { i32, \2* } ; ] [ TYPE: { i32, \2* } ; >tref tref> ] unit-test
--- 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&& ;

--- 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>
--- 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 ;
--- 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 ;
--- 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>

--- 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
--- 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
--- 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@ ;
--- 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
--- 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

--- 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? ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

--- 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 ;
--- 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 )