kernel: move recusrive-hashcode to math and add test

[factor.git] / core / kernel / kernel.factor

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 4db85a081761fd5f74fe1b88eb0145c054489ac9..e5389f401f2117e1cd302362ac99cdea1923d769 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -1,7 +1,8 @@
 ! 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 ;
+USE: slots.private
+USE: kernel.private
+USE: math.private
 IN: kernel
 
 BUILTIN: callstack ;
@@ -163,13 +164,13 @@ DEFER: if
 : 4keep ( ..a w x y z quot: ( ..a w x y z -- ..b ) -- ..b w x y z )
     [ 4dup ] dip 4dip ; inline
 
-: keepd ( ..a x y quot: ( ..a x y -- ..b x ) -- ..b x )
+: keepd ( ..a x y quot: ( ..a x y -- ..b ) -- ..b x )
     2keep drop ; inline
 
-: keepdd ( ..a x y z quot: ( ..a x y z -- ..b x ) -- ..b x )
+: keepdd ( ..a x y z quot: ( ..a x y z -- ..b ) -- ..b x )
     3keep 2drop ; inline
 
-: 2keepd ( ..a x y z quot: ( ..a x y z -- ..b x y ) -- ..b x y )
+: 2keepd ( ..a x y z quot: ( ..a x y z -- ..b ) -- ..b x y )
     3keep drop ; inline
 
 ! Cleavers
@@ -234,6 +235,9 @@ DEFER: if
 : 2with ( param1 param2 obj quot -- obj curried )
     with with ; inline
 
+: withd ( param obj quot -- obj curried )
+    swapd [ -rotd call ] 2curry ; inline
+
 : prepose ( quot1 quot2 -- composed )
     swap compose ; inline
 
@@ -275,6 +279,8 @@ UNION: boolean POSTPONE: t POSTPONE: f ;
 
 : most ( x y quot -- z ) 2keep ? ; inline
 
+: negate ( quot -- quot' ) [ not ] compose ; inline
+
 ! Loops
 : loop ( ... pred: ( ... -- ... ? ) -- ... )
     [ call ] keep [ loop ] curry when ; inline recursive
@@ -289,10 +295,10 @@ UNION: boolean POSTPONE: t POSTPONE: f ;
     [ [ dup ] compose ] dip while drop ; inline
 
 : until ( ..a pred: ( ..a -- ..b ? ) body: ( ..b -- ..a ) -- ..b )
-    [ [ not ] compose ] dip while ; inline
+    [ negate ] dip while ; inline
 
 ! Object protocol
-GENERIC: hashcode* ( depth obj -- code )
+GENERIC: hashcode* ( depth obj -- code ) flushable
 
 M: object hashcode* 2drop 0 ; inline
 
@@ -300,11 +306,6 @@ 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