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