simplified directory listing in cfactor, faster = and hashcode

cvs
Slava Pestov 2004-08-30 06:30:55 +00:00
parent 9416d77c04
commit 5cbeaee7df
4 changed files with 52 additions and 68 deletions

View File

@ -57,11 +57,13 @@ DEFER: str-hashcode
DEFER: sbuf= DEFER: sbuf=
DEFER: sbuf-clone DEFER: sbuf-clone
IN: files
DEFER: stat
DEFER: directory
IN: io-internals IN: io-internals
DEFER: port? DEFER: port?
DEFER: open-file DEFER: open-file
DEFER: stat
DEFER: read-dir
DEFER: client-socket DEFER: client-socket
DEFER: server-socket DEFER: server-socket
DEFER: close-port DEFER: close-port

View File

@ -27,53 +27,12 @@
IN: files IN: files
USE: combinators USE: combinators
USE: io-internals
USE: kernel
USE: lists USE: lists
USE: logic USE: logic
USE: math
USE: namespaces
USE: stack 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 -- ? ) : exists? ( file -- ? )
?path>file "exists" swap get* ; stat >boolean ;
: directory? ( file -- ? ) : directory? ( file -- ? )
?path>file "directory" swap get* ; stat dup [ car ] when ;
: 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 ;

View File

@ -44,30 +44,56 @@ USE: words
USE: unparser USE: unparser
USE: vectors 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 ) : hashcode ( obj -- hash )
#! If two objects are =, they must have equal hashcodes. #! If two objects are =, they must have equal hashcodes.
[ {
[ word? ] [ word-hashcode ] [ ]
[ cons? ] [ 4 cons-hashcode ] [ word-hashcode ]
[ string? ] [ str-hashcode ] [ 4 cons-hashcode ]
[ number? ] [ >fixnum ] [ drop 0 ]
[ drop t ] [ drop 0 ] [ >fixnum ]
] cond ; [ >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 -- ? ) : = ( obj obj -- ? )
#! Push t if a is isomorphic to b. #! Push t if a is isomorphic to b.
2dup eq? [ 2dup eq? [ 2drop t ] [ equal? ] ifte ;
2drop t
] [
[
[ number? ] [ number= ]
[ cons? ] [ cons= ]
[ vector? ] [ vector= ]
[ string? ] [ str= ]
[ sbuf? ] [ sbuf= ]
[ drop t ] [ 2drop f ]
] cond
] ifte ;
: clone ( obj -- obj ) : clone ( obj -- obj )
[ [

View File

@ -61,10 +61,7 @@ void primitive_read_dir(void)
{ {
CELL name = tag_object(from_c_string( CELL name = tag_object(from_c_string(
file->d_name)); file->d_name));
CELL dirp = tag_boolean( result = tag_cons(cons(name,result));
file->d_type == DT_DIR);
CELL entry = tag_cons(cons(name,dirp));
result = tag_cons(cons(entry,result));
} }
closedir(dir); closedir(dir);