instances word rewritten in factor

library/bootstrap/primitives.factor

@@ -200,7 +200,6 @@ vocabularies get [
     [ "<tuple>" "kernel-internals"            [ [ number ] [ tuple ] ] ]
     [ ">array" "kernel-internals"             [ [ object ] [ array ] ] ]
     [ ">tuple" "kernel-internals"             [ [ object ] [ tuple ] ] ]
-    [ "(instances)" "memory"                  [ [ integer ] [ general-list ] ] ]
     [ "begin-scan" "memory"                   [ [ ] [ ] ] ]
     [ "next-object" "memory"                  [ [ ] [ object ] ] ]
     [ "end-scan" "memory"                     [ [ ] [ object ] ] ]                         

library/tools/heap-stats.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: memory
-USING: kernel lists math namespaces prettyprint stdio words
+USING: errors generic kernel lists math namespaces prettyprint
-vectors unparser generic ;
+stdio unparser vectors words ;
 
 : kb. 1024 /i unparse write " KB" write ;
 
@@ -30,6 +30,26 @@ vectors unparser generic ;
     #! Print heap allocation breakdown.
     0 heap-stats [ dupd uncons heap-stat. 1 + ] each drop ;
 
+: (each-object) ( quot -- )
+    next-object dup [
+        swap dup slip (each-object)
+    ] [
+        2drop
+    ] ifte ; inline
+
+: each-object ( quot -- )
+    #! Applies the quotation to each object in the image.
+    [
+        begin-scan (each-object)
+    ] [
+        end-scan rethrow
+    ] catch ; inline
+
 : instances ( class -- list )
-    #! Return a list of all instances of a built-in class.
+    #! Return a list of all instances of a built-in or tuple
-    "builtin-type" word-property (instances) ;
+    #! class.
+    [
+        [
+            dup class pick = [ , ] [ drop ] ifte
+        ] each-object drop
+    ] make-list ;

native/primitives.c

@@ -179,7 +179,6 @@ void* primitives[] = {
 	primitive_tuple,
 	primitive_to_array,
 	primitive_to_tuple,
-	primitive_instances,
 	primitive_begin_scan,
 	primitive_next_object,
 	primitive_end_scan

native/scan.c

@@ -81,35 +81,3 @@ void primitive_heap_stats(void)
 
 	dpush(list);
 }
-
-void primitive_instances(void)
-{
-	CELL list = F;
-	CELL search_type = to_fixnum(dpop());
-	CELL here;
-
-	primitive_gc();
-
-	here = active.here;
-
-	begin_heap_scan();
-	
-	for(;;)
-	{
-		CELL size, type;
-		CELL obj = heap_step(&size,&type);
-
-		if(walk_donep())
-			break;
-
-		/* don't want an infinite loop if we ask for a list of all
-		conses in the image! */
-		if(heap_scan_ptr >= here)
-			break;
-
-		if(search_type == type)
-			list = cons(obj,list);
-	}
-
-	dpush(list);
-}