From: John Benediktsson Date: Thu, 15 Oct 2020 22:26:46 +0000 (-0700) Subject: combinators: move recursive-hashcode to kernel vocab. X-Git-Tag: 0.99~3056 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=bd7b245a4016d91223be3633ab902803f8ed1d7f combinators: move recursive-hashcode to kernel vocab. It makes more sense there, since hashcode, hashcode* and other related words are in kernel. --- diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor index 1666bdb4a4..b396187a63 100644 --- a/core/arrays/arrays.factor +++ b/core/arrays/arrays.factor @@ -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 ; inline M: f new-sequence drop [ f ] [ 0 ] if-zero ; inline diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor index ee7f5d660e..315a603f2b 100644 --- a/core/byte-arrays/byte-arrays.factor +++ b/core/byte-arrays/byte-arrays.factor @@ -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 diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 4e44dfe5ae..9b1b8eb82c 100644 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -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 diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 9cda95da6a..7d072f93a3 100644 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -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 ; inline diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 35bbfdfb38..4db85a0817 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -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 -- ? ) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index bb76410c2e..f4b7cb2985 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -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 ; + : 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 =