]> gitweb.factorcode.org Git - factor.git/commitdiff
combinators: move recursive-hashcode to kernel vocab.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 15 Oct 2020 22:26:46 +0000 (15:26 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 15 Oct 2020 22:33:58 +0000 (15:33 -0700)
It makes more sense there, since hashcode, hashcode* and other
related words are in kernel.

core/arrays/arrays.factor
core/byte-arrays/byte-arrays.factor
core/combinators/combinators.factor
core/hashtables/hashtables.factor
core/kernel/kernel.factor
core/sequences/sequences.factor

index 1666bdb4a4732a5c829764d916fa54c5f3e876ae..b396187a63a07063b8211bb742fd0e42cd82ce68 100644 (file)
@@ -14,6 +14,7 @@ M: array nth-unsafe [ integer>fixnum ] dip array-nth ; inline
 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
 
index ee7f5d660e1ed1b6caaba570e5e6495e30cbc24f..315a603f2b4819a90d740c58eb2d6cd557533613 100644 (file)
@@ -19,22 +19,16 @@ M: byte-array clone-like
 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
index 4e44dfe5ae121b40755453858c8ebdaab31d9ec8..9b1b8eb82cba5b24b4601aaa3c4ec4a8e89fc0e6 100644 (file)
@@ -1,8 +1,8 @@
 ! 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
@@ -189,31 +189,5 @@ PRIVATE>
         [ 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
index 9cda95da6a20535e8ce7d9146f724acd1721fb49..7d072f93a391a79d100b87f1dd7f3e786d238f86 100644 (file)
@@ -171,6 +171,12 @@ M: hashtable clone
 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
 
index 35bbfdfb38c0652681b0f1054ce2e220d7e9ee21..4db85a081761fd5f74fe1b88eb0145c054489ac9 100644 (file)
@@ -1,5 +1,6 @@
 ! 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
 
@@ -299,6 +300,19 @@ M: f hashcode* 2drop 31337 ; inline
 
 : 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 ] [
@@ -309,14 +323,6 @@ M: f hashcode* 2drop 31337 ; inline
         ] 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 -- ? )
index bb76410c2e7ff4c85eb5c46df9d00242dfc552fc..f4b7cb2985ae103407c3f3263ef08c70d578250d 100644 (file)
@@ -698,6 +698,10 @@ ERROR: assert-sequence got expected ;
 : 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 )
@@ -711,9 +715,16 @@ PRIVATE>
 : 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 =