simplified directory listing in cfactor, faster = and hashcode
parent
9416d77c04
commit
5cbeaee7df
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in New Issue