M: array set-nth-unsafe [ integer>fixnum ] dip set-array-nth ; inline
M: array resize resize-array ; inline
M: array equal? over array? [ sequence= ] [ 2drop f ] if ;
+M: array hashcode* [ sequence-hashcode ] recursive-hashcode ;
M: object new-sequence drop 0 <array> ; inline
M: f new-sequence drop [ f ] [ 0 <array> ] if-zero ; inline
M: byte-array length length>> ; inline
M: byte-array nth-unsafe swap integer>fixnum alien-unsigned-1 ; inline
M: byte-array set-nth-unsafe swap integer>fixnum set-alien-unsigned-1 ; inline
-: >byte-array ( seq -- byte-array ) B{ } clone-like ; inline
M: byte-array new-sequence drop (byte-array) ; inline
-
-M: byte-array equal?
- over byte-array? [ sequence= ] [ 2drop f ] if ;
-
-M: byte-array resize
- resize-byte-array ; inline
+M: byte-array equal? over byte-array? [ sequence= ] [ 2drop f ] if ;
+M: byte-array hashcode* [ sequence-hashcode ] recursive-hashcode ;
+M: byte-array resize resize-byte-array ; inline
INSTANCE: byte-array sequence
INSTANCE: byte-array byte-sequence
+: >byte-array ( seq -- byte-array ) B{ } clone-like ; inline
: 1byte-array ( x -- byte-array ) B{ } 1sequence ; inline
-
: 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline
-
: 3byte-array ( x y z -- byte-array ) B{ } 3sequence ; inline
-
: 4byte-array ( w x y z -- byte-array ) B{ } 4sequence ; inline
! Copyright (C) 2006, 2010 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays hashtables kernel
-kernel.private make math math.order math.private quotations
-sequences sequences.private sets sorting words ;
+USING: accessors arrays assocs kernel kernel.private make math
+math.order math.private quotations sequences sequences.private
+sets sorting words ;
IN: combinators
! Most of these combinators have compile-time expansions in
[ drop linear-case-quot ]
} cond ;
-: recursive-hashcode ( n obj quot -- code )
- pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline
-
-! These go here, not in sequences and hashtables, since those
-! two cannot depend on us
-M: sequence hashcode* [ sequence-hashcode ] recursive-hashcode ;
-
-M: array hashcode* [ sequence-hashcode ] recursive-hashcode ;
-
-M: byte-array hashcode* [ sequence-hashcode ] recursive-hashcode ;
-
-M: reversed hashcode* [ sequence-hashcode ] recursive-hashcode ;
-
-M: slice hashcode* [ sequence-hashcode ] recursive-hashcode ;
-
-M: iota hashcode*
- over 0 <= [ 2drop 0 ] [
- nip length 0 swap [ sequence-hashcode-step ] each-integer
- ] if ;
-
-M: hashtable hashcode*
- [
- dup assoc-size 1 eq?
- [ assoc-hashcode ] [ nip assoc-size ] if
- ] recursive-hashcode ;
-
: to-fixed-point ( ... object quot: ( ... object(n) -- ... object(n+1) ) -- ... object(n) )
[ keep over = ] keep [ to-fixed-point ] curry unless ; inline recursive
M: hashtable equal?
over hashtable? [ assoc= ] [ 2drop f ] if ;
+M: hashtable hashcode*
+ [
+ dup assoc-size 1 eq?
+ [ assoc-hashcode ] [ nip assoc-size ] if
+ ] recursive-hashcode ;
+
! Default method
M: assoc new-assoc drop <hashtable> ; inline
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
+IN: math DEFER: <= DEFER: - ! for bootstrap since math uses kernel
USING: kernel.private slots.private math.private ;
IN: kernel
: hashcode ( obj -- code ) 3 swap hashcode* ; inline
+IN: kernel
+
+: recursive-hashcode ( n obj quot -- code )
+ pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline
+
+GENERIC: equal? ( obj1 obj2 -- ? )
+
+M: object equal? 2drop f ; inline
+
+TUPLE: identity-tuple ;
+
+M: identity-tuple equal? 2drop f ; inline
+
: identity-hashcode ( obj -- code )
dup tag 0 eq? [
dup tag 1 eq? [ drop 0 ] [
] if
] unless ; inline
-GENERIC: equal? ( obj1 obj2 -- ? )
-
-M: object equal? 2drop f ; inline
-
-TUPLE: identity-tuple ;
-
-M: identity-tuple equal? 2drop f ; inline
-
M: identity-tuple hashcode* nip identity-hashcode ; inline
: = ( obj1 obj2 -- ? )
: assert-sequence= ( a b -- )
2dup sequence= [ 2drop ] [ assert-sequence ] if ;
+M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
+
+M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
+
<PRIVATE
: sequence-hashcode-step ( oldhash newpart -- newhash )
: sequence-hashcode ( n seq -- x )
[ 0 ] 2dip [ hashcode* sequence-hashcode-step ] with each ; inline
-M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
+M: sequence hashcode* [ sequence-hashcode ] recursive-hashcode ;
-M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
+M: iota hashcode*
+ over 0 <= [ 2drop 0 ] [
+ nip length 0 swap [ sequence-hashcode-step ] each-integer
+ ] if ;
+
+M: reversed hashcode* [ sequence-hashcode ] recursive-hashcode ;
+
+M: slice hashcode* [ sequence-hashcode ] recursive-hashcode ;
: move ( to from seq -- )
2over =