simplified directory listing in cfactor, faster = and hashcode

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index a2d74f3d4debadbbf2fa0e389a0c4a6434d0541a..a4f6bafc3cc2b963d9b2a37791ab9fcb6fcfe26f 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -57,11 +57,13 @@ DEFER: str-hashcode
 DEFER: sbuf=
 DEFER: sbuf-clone
 
+IN: files
+DEFER: stat
+DEFER: directory
+
 IN: io-internals
 DEFER: port?
 DEFER: open-file
-DEFER: stat
-DEFER: read-dir
 DEFER: client-socket
 DEFER: server-socket
 DEFER: close-port

diff --git a/library/platform/native/files.factor b/library/platform/native/files.factor
index 92d21c5cce508f505c35509afeccd481ce62e97e..4ebf34b3199d1cbe13a111b031071e1991dc2411 100644 (file)
--- a/library/platform/native/files.factor
+++ b/library/platform/native/files.factor
@@ -27,53 +27,12 @@
 
 IN: files
 USE: combinators
-USE: io-internals
-USE: kernel
 USE: lists
 USE: logic
-USE: math
-USE: namespaces
 USE: stack
-USE: strings
-
-: <file> ( path -- file )
-    #! Create an empty file object. Do not use this directly.
-    <namespace> [
-        "path" set
-        f "exists" set
-        f "directory" set
-        0 "permissions" set
-        0 "size" set
-        0 "mod-time" set
-    ] extend ;
-
-: path>file ( path -- file )
-    dup <file> [
-        stat [
-            "exists" on
-            [
-                "directory"
-                "permissions"
-                "size"
-                "mod-time"
-            ] [
-                set
-            ] 2each
-        ] when*
-    ] extend ;
-
-: ?path>file ( path/file -- file )
-    dup string? [ path>file ] when ;
 
 : exists? ( file -- ? )
-    ?path>file "exists" swap get* ;
+    stat >boolean ;
 
 : directory? ( file -- ? )
-    ?path>file "directory" swap get* ;
-
-: dirent>file ( parent name dir? -- file )
-    -rot "/" swap cat3 <file> [ "directory" set ] extend ;
-
-: directory ( file -- list )
-    #! Push a list of file objects in the directory.
-    dup read-dir [ dupd uncons dirent>file ] map nip ;
+    stat dup [ car ] when ;

diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor
index e6563ad71ec957e7bab32455f9b7662f8a3b8441..8f045eb2b25335940218c1d0a305b5ed2f937f04 100644 (file)
--- a/library/platform/native/kernel.factor
+++ b/library/platform/native/kernel.factor
@@ -44,30 +44,56 @@ USE: words
 USE: unparser
 USE: vectors
 
+! The 'fake vtable' used here speeds things up a lot.
+! It is quite clumsy, however. A higher-level CLOS-style
+! 'generic words' system will be built later.
+
+: generic ( obj vtable -- )
+    over type-of swap vector-nth call ;
+
 : hashcode ( obj -- hash )
     #! If two objects are =, they must have equal hashcodes.
-    [
-        [ word? ] [ word-hashcode ]
-        [ cons? ] [ 4 cons-hashcode ]
-        [ string? ] [ str-hashcode ]
-        [ number? ] [ >fixnum ]
-        [ drop t ] [ drop 0 ]
-    ] cond ;
+    {
+        [ ]
+        [ word-hashcode ]
+        [ 4 cons-hashcode ]
+        [ drop 0 ]
+        [ >fixnum ]
+        [ >fixnum ]
+        [ drop 0 ]
+        [ drop 0 ]
+        [ drop 0 ]
+        [ drop 0 ]
+        [ str-hashcode ]
+        [ drop 0 ]
+        [ drop 0 ]
+        [ >fixnum ]
+        [ >fixnum ]
+    } generic ;
+
+: equal? ( obj obj -- ? )
+    #! Use = instead.
+    {
+        [ number= ]
+        [ eq? ]
+        [ cons= ]
+        [ eq? ]
+        [ number= ]
+        [ number= ]
+        [ eq? ]
+        [ eq? ]
+        [ eq? ]
+        [ vector= ]
+        [ str= ]
+        [ sbuf= ]
+        [ eq? ]
+        [ number= ]
+        [ number= ]
+    } generic ;
 
 : = ( obj obj -- ? )
     #! Push t if a is isomorphic to b.
-    2dup eq? [
-        2drop t
-    ] [
-        [
-            [ number? ] [ number= ]
-            [ cons? ] [ cons= ]
-            [ vector? ] [ vector= ]
-            [ string? ] [ str= ]
-            [ sbuf? ] [ sbuf= ]
-            [ drop t ] [ 2drop f ]
-        ] cond
-    ] ifte ;
+    2dup eq? [ 2drop t ] [ equal? ] ifte ;
 
 : clone ( obj -- obj )
     [

diff --git a/native/file.c b/native/file.c
index 502cd3c91e32c22aa749c052841267db1df48a3f..9857d80ef3972f07cd8d3a1b35da03c471c54e80 100644 (file)
--- a/native/file.c
+++ b/native/file.c
@@ -61,10 +61,7 @@ void primitive_read_dir(void)
                {
                        CELL name = tag_object(from_c_string(
                                file->d_name));
-                       CELL dirp = tag_boolean(
-                               file->d_type == DT_DIR);
-                       CELL entry = tag_cons(cons(name,dirp));
-                       result = tag_cons(cons(entry,result));
+                       result = tag_cons(cons(name,result));
                }
 
                closedir(dir);