instances word rewritten in factor

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 694ddaf8d63e42bcd3845d4b548f16b255fd5274..4364f7fcfbbe30bca12fe4d84aa75da2fe88c90c 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/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 ] ] ]                         

diff --git a/library/tools/heap-stats.factor b/library/tools/heap-stats.factor
index 9cbeb5f5bbc2e9af661e26f0a21b50a5d0640d9a..26273599c9c2361407af6318516e17c598751be1 100644 (file)
--- a/library/tools/heap-stats.factor
+++ b/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
-vectors unparser generic ;
+USING: errors generic kernel lists math namespaces prettyprint
+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.
-    "builtin-type" word-property (instances) ;
+    #! Return a list of all instances of a built-in or tuple
+    #! class.
+    [
+        [
+            dup class pick = [ , ] [ drop ] ifte
+        ] each-object drop
+    ] make-list ;

diff --git a/native/primitives.c b/native/primitives.c
index 2775f4a02e46bdce76a60215efcf2722c9be8a6c..f84b55328c8769814f7a483e2849ce6211bb83d5 100644 (file)
--- a/native/primitives.c
+++ b/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

diff --git a/native/scan.c b/native/scan.c
index b7a2170d3a6a5e1c703a34d265945b0d21fd9cde..517a694c76d828f99bf4637326f5261e1961959b 100644 (file)
--- a/native/scan.c
+++ b/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);
-}