steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor into new_codegen

db4
Slava Pestov 2008-10-19 18:10:48 -05:00
parent 0b07edb8c9 f324ceb2b0
commit b6ec4dc6ff
43 changed files with 420 additions and 274 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/http/server/static/static.factor
View File

@ -59,8 +59,8 @@ TUPLE: file-responder root hook special allow-listings ;
\ serve-file NOTICE add-input-logging
: file. ( name dirp -- )
[ "/" append ] when
: file. ( name -- )
dup link-info directory? [ "/" append ] when
dup <a =href a> escape-string write </a> ;
: directory. ( path -- )
@ -68,7 +68,7 @@ TUPLE: file-responder root hook special allow-listings ;
[ <h1> file-name escape-string write </h1> ]
[
<ul>
directory sort-keys
directory-files
[ <li> file. </li> ] assoc-each
</ul>
] bi

6
basis/io/monitors/recursive/recursive.factor
View File

@ -19,11 +19,13 @@ DEFER: add-child-monitor
: add-child-monitors ( path -- )
#! We yield since this directory scan might take a while.
directory* [ first add-child-monitor ] each yield ;
[
[ add-child-monitor ] each yield
] with-directory-files ;
: add-child-monitor ( path -- )
notify? [ dup { +add-file+ } monitor tget queue-change ] when
qualify-path dup link-info type>> +directory+ eq? [
qualify-path dup link-info directory? [
[ add-child-monitors ]
[
[

23
basis/io/unix/files/files.factor
View File

@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar
io.encodings.binary accessors sequences strings system
io.files.private destructors vocabs.loader calendar.unix
unix.stat alien.c-types arrays unix.users unix.groups
environment ;
environment fry io.encodings.utf8 alien.strings ;
IN: io.unix.files
M: unix cwd ( -- path )
@ -138,6 +138,27 @@ os {
{ linux [ ] }
} case
: with-unix-directory ( path quot -- )
[ opendir dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
: find-next-file ( DIR* -- byte-array )
"dirent" <c-object>
f <void*>
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;
M: unix >directory-entry ( byte-array -- directory-entry )
[ dirent-d_name utf8 alien>string ]
[ dirent-d_type ] bi directory-entry boa ;
M: unix (directory-entries) ( path -- seq )
[
'[ _ find-next-file dup ]
[ >directory-entry ]
[ drop ] produce
] with-unix-directory ;
<PRIVATE
: stat-mode ( path -- mode )

36
basis/io/windows/files/files.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.binary io.backend io.files io.buffers
io.windows kernel math splitting
io.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words symbols system
io.ports destructors accessors math.bitwise ;
io.ports destructors accessors math.bitwise continuations
windows.errors arrays ;
IN: io.windows.files
: open-file ( path access-mode create-mode flags -- handle )
@ -113,8 +114,35 @@ M: windows delete-directory ( path -- )
normalize-path
RemoveDirectory win32-error=0/f ;
M: windows normalize-directory ( string -- string )
normalize-path "\\" ?tail drop "\\*" append ;
M: windows >directory-entry ( byte-array -- directory-entry )
[ WIN32_FIND_DATA-cFileName utf16n alien>string ]
[ WIN32_FIND_DATA-dwFileAttributes ]
bi directory-entry boa ;
: find-first-file ( path -- WIN32_FIND_DATA handle )
"WIN32_FIND_DATA" <c-object> tuck
FindFirstFile
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ;
: find-next-file ( path -- WIN32_FIND_DATA/f )
"WIN32_FIND_DATA" <c-object> tuck
FindNextFile 0 = [
GetLastError ERROR_NO_MORE_FILES = [
win32-error
] unless drop f
] when ;
M: windows (directory-entries) ( path -- seq )
"\\" ?tail drop "\\*" append
find-first-file [ >directory-entry ] dip
[
'[
[ _ find-next-file dup ]
[ >directory-entry ]
[ drop ] produce
over name>> "." = [ nip ] [ swap prefix ] if
]
] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
SYMBOLS: +read-only+ +hidden+ +system+
+archive+ +device+ +normal+ +temporary+

2
basis/io/windows/files/unique/unique.factor
View File

@ -1,6 +1,6 @@
USING: kernel system io.files.unique.backend
windows.kernel32 io.windows io.windows.files io.ports windows
destructors ;
destructors environment ;
IN: io.windows.files.unique
M: windows (make-unique-file) ( path -- )

2
basis/logging/server/server.factor
View File

@ -83,7 +83,7 @@ SYMBOL: log-files
: (rotate-logs) ( -- )
(close-logs)
log-root directory [ drop rotate-log ] assoc-each ;
log-root directory-files [ rotate-log ] each ;
: log-server-loop ( -- )
receive unclip {

2
basis/stack-checker/known-words/known-words.factor
View File

@ -396,8 +396,6 @@ do-primitive alien-invoke alien-indirect alien-callback
\ (exists?) { string } { object } define-primitive
\ (directory) { string } { array } define-primitive
\ gc { } { } define-primitive
\ gc-stats { } { array } define-primitive

7
basis/tools/vocabs/vocabs.factor
View File

@ -14,8 +14,7 @@ IN: tools.vocabs
: vocab-tests-dir ( vocab -- paths )
dup vocab-dir "tests" append-path vocab-append-path dup [
dup exists? [
dup directory keys
[ ".factor" tail? ] filter
dup directory-files [ ".factor" tail? ] filter
[ append-path ] with map
] [ drop f ] if
] [ drop f ] if ;
@ -208,7 +207,9 @@ M: vocab-link summary vocab-summary ;
dup vocab-authors-path set-vocab-file-contents ;
: subdirs ( dir -- dirs )
directory [ second ] filter keys natural-sort ;
[
[ link-info directory? ] filter
] with-directory-files natural-sort ;
: (all-child-vocabs) ( root name -- vocabs )
[ vocab-dir append-path subdirs ] keep

2
basis/unix/bsd/bsd.factor
View File

@ -3,8 +3,6 @@
USING: alien.syntax combinators system vocabs.loader ;
IN: unix
! FreeBSD
: MAXPATHLEN 1024 ; inline
: O_RDONLY HEX: 0000 ; inline

17
basis/unix/bsd/freebsd/freebsd.factor
View File

@ -13,6 +13,23 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "u_int32_t" "d_fileno" }
{ "u_int16_t" "d_reclen" }
{ "u_int8_t" "d_type" }
{ "u_int8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: DT_UNKNOWN 0 ; inline
: DT_FIFO 1 ; inline
: DT_CHR 2 ; inline
: DT_DIR 4 ; inline
: DT_BLK 6 ; inline
: DT_REG 8 ; inline
: DT_LNK 10 ; inline
: DT_SOCK 12 ; inline
: DT_WHT 14 ; inline
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

52
basis/unix/bsd/macosx/macosx.factor
View File

@ -13,6 +13,43 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
: _UTX_USERSIZE 256 ; inline
: _UTX_LINESIZE 32 ; inline
: _UTX_IDSIZE 4 ; inline
: _UTX_HOSTSIZE 256 ; inline
C-STRUCT: utmpx
{ { "char" _UTX_USERSIZE } "ut_user" }
{ { "char" _UTX_IDSIZE } "ut_id" }
{ { "char" _UTX_LINESIZE } "ut_line" }
{ "pid_t" "ut_pid" }
{ "short" "ut_type" }
{ "timeval" "ut_tv" }
{ { "char" _UTX_HOSTSIZE } "ut_host" }
{ { "uint" 16 } "ut_pad" } ;
: __DARWIN_MAXPATHLEN 1024 ; inline
: __DARWIN_MAXNAMELEN 255 ; inline
: __DARWIN_MAXNAMELEN+1 255 ; inline
C-STRUCT: dirent
{ "ino_t" "d_ino" }
{ "__uint16_t" "d_reclen" }
{ "__uint8_t" "d_type" }
{ "__uint8_t" "d_namlen" }
{ { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
: DT_UNKNOWN 0 ; inline
: DT_FIFO 1 ; inline
: DT_CHR 2 ; inline
: DT_DIR 4 ; inline
: DT_BLK 6 ; inline
: DT_REG 8 ; inline
: DT_LNK 10 ; inline
: DT_SOCK 12 ; inline
: DT_WHT 14 ; inline
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline
@ -117,18 +154,3 @@ C-STRUCT: addrinfo
: ETIME 101 ; inline
: EOPNOTSUPP 102 ; inline
: ENOPOLICY 103 ; inline
: _UTX_USERSIZE 256 ; inline
: _UTX_LINESIZE 32 ; inline
: _UTX_IDSIZE 4 ; inline
: _UTX_HOSTSIZE 256 ; inline
C-STRUCT: utmpx
{ { "char" _UTX_USERSIZE } "ut_user" }
{ { "char" _UTX_IDSIZE } "ut_id" }
{ { "char" _UTX_LINESIZE } "ut_line" }
{ "pid_t" "ut_pid" }
{ "short" "ut_type" }
{ "timeval" "ut_tv" }
{ { "char" _UTX_HOSTSIZE } "ut_host" }
{ { "uint" 16 } "ut_pad" } ;

17
basis/unix/bsd/netbsd/netbsd.factor
View File

@ -13,6 +13,23 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "ino_t" "d_fileno" }
{ "__uint16_t" "d_reclen" }
{ "__uint16_t" "d_namlen" }
{ "__uint8_t" "d_type" }
{ { "char" 512 } "d_name" } ;
: DT_UNKNOWN 0 ; inline
: DT_FIFO 1 ; inline
: DT_CHR 2 ; inline
: DT_DIR 4 ; inline
: DT_BLK 6 ; inline
: DT_REG 8 ; inline
: DT_LNK 10 ; inline
: DT_SOCK 12 ; inline
: DT_WHT 14 ; inline
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

18
basis/unix/bsd/openbsd/openbsd.factor
View File

@ -13,6 +13,24 @@ C-STRUCT: addrinfo
{ "char*" "canonname" }
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "__uint32_t" "d_fileno" }
{ "__uint16_t" "d_reclen" }
{ "__uint8_t" "d_type" }
{ "__uint8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: DT_UNKNOWN 0 ; inline
: DT_FIFO 1 ; inline
: DT_CHR 2 ; inline
: DT_DIR 4 ; inline
: DT_BLK 6 ; inline
: DT_REG 8 ; inline
: DT_LNK 10 ; inline
: DT_SOCK 12 ; inline
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

4
basis/unix/linux/fs/fs.factor
View File

@ -1,6 +1,4 @@
USING: alien.syntax ;
IN: unix.linux.fs
: MS_RDONLY 1 ; ! Mount read-only.
@ -22,4 +20,4 @@ FUNCTION: int mount
! FUNCTION: int umount2 ( char* file, int flags ) ;
FUNCTION: int umount ( char* file ) ;
FUNCTION: int umount ( char* file ) ;

7
basis/unix/linux/linux.factor
View File

@ -92,6 +92,13 @@ C-STRUCT: passwd
{ "char*" "pw_dir" }
{ "char*" "pw_shell" } ;
C-STRUCT: dirent
{ "__ino_t" "d_ino" }
{ "__off_t" "d_off" }
{ "ushort" "d_reclen" }
{ "uchar" "d_type" }
{ { "char" 256 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

7
basis/unix/stat/linux/linux.factor
View File

@ -1,11 +1,8 @@
USING: layouts combinators vocabs.loader ;
IN: unix.stat
cell-bits
{
{
{ 32 [ "unix.stat.linux.32" require ] }
{ 64 [ "unix.stat.linux.64" require ] }
}
case
} case

120
basis/unix/stat/macosx/macosx.factor
View File

@ -1,4 +1,5 @@
USING: kernel alien.syntax math ;
USING: kernel alien.syntax math unix math.bitwise
alien.c-types alien sequences grouping accessors combinators ;
IN: unix.stat
! Mac OS X ppc
@ -30,3 +31,120 @@ FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;
: stat ( path buf -- n ) stat64 ;
: lstat ( path buf -- n ) lstat64 ;
: MNT_RDONLY HEX: 00000001 ; inline
: MNT_SYNCHRONOUS HEX: 00000002 ; inline
: MNT_NOEXEC HEX: 00000004 ; inline
: MNT_NOSUID HEX: 00000008 ; inline
: MNT_NODEV HEX: 00000010 ; inline
: MNT_UNION HEX: 00000020 ; inline
: MNT_ASYNC HEX: 00000040 ; inline
: MNT_EXPORTED HEX: 00000100 ; inline
: MNT_QUARANTINE HEX: 00000400 ; inline
: MNT_LOCAL HEX: 00001000 ; inline
: MNT_QUOTA HEX: 00002000 ; inline
: MNT_ROOTFS HEX: 00004000 ; inline
: MNT_DOVOLFS HEX: 00008000 ; inline
: MNT_DONTBROWSE HEX: 00100000 ; inline
: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline
: MNT_AUTOMOUNTED HEX: 00400000 ; inline
: MNT_JOURNALED HEX: 00800000 ; inline
: MNT_NOUSERXATTR HEX: 01000000 ; inline
: MNT_DEFWRITE HEX: 02000000 ; inline
: MNT_MULTILABEL HEX: 04000000 ; inline
: MNT_NOATIME HEX: 10000000 ; inline
: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline
: MNT_VISFLAGMASK ( -- n )
{
MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC
MNT_NOSUID MNT_NODEV MNT_UNION
MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE
MNT_LOCAL MNT_QUOTA
MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE
MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED
MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME
} flags ; inline
: MNT_UPDATE HEX: 00010000 ; inline
: MNT_RELOAD HEX: 00040000 ; inline
: MNT_FORCE HEX: 00080000 ; inline
: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline
: VFS_GENERIC 0 ; inline
: VFS_NUMMNTOPS 1 ; inline
: VFS_MAXTYPENUM 1 ; inline
: VFS_CONF 2 ; inline
: VFS_SET_PACKAGE_EXTS 3 ; inline
: MNT_WAIT 1 ; inline
: MNT_NOWAIT 2 ; inline
: VFS_CTL_VERS1 HEX: 01 ; inline
: VFS_CTL_STATFS HEX: 00010001 ; inline
: VFS_CTL_UMOUNT HEX: 00010002 ; inline
: VFS_CTL_QUERY HEX: 00010003 ; inline
: VFS_CTL_NEWADDR HEX: 00010004 ; inline
: VFS_CTL_TIMEO HEX: 00010005 ; inline
: VFS_CTL_NOLOCKS HEX: 00010006 ; inline
C-STRUCT: vfsquery
{ "uint32_t" "vq_flags" }
{ { "uint32_t" 31 } "vq_spare" } ;
: VQ_NOTRESP HEX: 0001 ; inline
: VQ_NEEDAUTH HEX: 0002 ; inline
: VQ_LOWDISK HEX: 0004 ; inline
: VQ_MOUNT HEX: 0008 ; inline
: VQ_UNMOUNT HEX: 0010 ; inline
: VQ_DEAD HEX: 0020 ; inline
: VQ_ASSIST HEX: 0040 ; inline
: VQ_NOTRESPLOCK HEX: 0080 ; inline
: VQ_UPDATE HEX: 0100 ; inline
: VQ_FLAG0200 HEX: 0200 ; inline
: VQ_FLAG0400 HEX: 0400 ; inline
: VQ_FLAG0800 HEX: 0800 ; inline
: VQ_FLAG1000 HEX: 1000 ; inline
: VQ_FLAG2000 HEX: 2000 ; inline
: VQ_FLAG4000 HEX: 4000 ; inline
: VQ_FLAG8000 HEX: 8000 ; inline
: NFSV4_MAX_FH_SIZE 128 ; inline
: NFSV3_MAX_FH_SIZE 64 ; inline
: NFSV2_MAX_FH_SIZE 32 ; inline
: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline
! C-STRUCT: fhandle
! { "int" "fh_len" }
! { { "uchar" NFS_MAX_FH_SIZE } "fh_data" } ;
! TYPEDEF: fhandle fhandle_t
: MFSNAMELEN 15 ; inline
: MNAMELEN 90 ; inline
: MFSTYPENAMELEN 16 ; inline
C-STRUCT: fsid_t
{ { "int32_t" 2 } "val" } ;
C-STRUCT: statfs64
{ "uint32_t" "f_bsize" }
{ "int32_t" "f_iosize" }
{ "uint64_t" "f_blocks" }
{ "uint64_t" "f_bfree" }
{ "uint64_t" "f_bavail" }
{ "uint64_t" "f_files" }
{ "uint64_t" "f_ffree" }
{ "fsid_t" "f_fsid" }
{ "uid_t" "f_owner" }
{ "uint32_t" "f_type" }
{ "uint32_t" "f_flags" }
{ "uint32_t" "f_fssubtype" }
{ { "char" MFSTYPENAMELEN } "f_fstypename" }
{ { "char" MAXPATHLEN } "f_mntonname" }
{ { "char" MAXPATHLEN } "f_mntfromname" }
{ { "uint32_t" 8 } "f_reserved" } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;

8
basis/unix/stat/stat.factor
View File

@ -27,11 +27,7 @@ FUNCTION: int mkdir ( char* path, mode_t mode ) ;
} case >>
: file-status ( pathname -- stat )
"stat" <c-object> [
[ stat ] unix-system-call drop
] keep ;
"stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;
: link-status ( pathname -- stat )
"stat" <c-object> [
[ lstat ] unix-system-call drop
] keep ;
"stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;

10
basis/unix/types/linux/linux.factor
View File

@ -1,10 +1,6 @@
USING: alien.syntax ;
IN: unix.types
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TYPEDEF: ulonglong __uquad_type
TYPEDEF: ulong __ulongword_type
TYPEDEF: long __sword_type
@ -13,17 +9,17 @@ TYPEDEF: long __slongword_type
TYPEDEF: uint __u32_type
TYPEDEF: int __s32_type
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TYPEDEF: __uquad_type dev_t
TYPEDEF: __ulongword_type ino_t
TYPEDEF: ino_t __ino_t
TYPEDEF: __u32_type mode_t
TYPEDEF: __uword_type nlink_t
TYPEDEF: __u32_type uid_t
TYPEDEF: __u32_type gid_t
TYPEDEF: __slongword_type off_t
TYPEDEF: off_t __off_t
TYPEDEF: __slongword_type blksize_t
TYPEDEF: __slongword_type blkcnt_t
TYPEDEF: __sword_type ssize_t
TYPEDEF: __s32_type pid_t
TYPEDEF: __slongword_type time_t
TYPEDEF: __slongword_type time_t

13
basis/unix/types/netbsd/netbsd.factor
View File

@ -3,19 +3,6 @@ IN: unix.types
! NetBSD 4.0
TYPEDEF: short __int16_t
TYPEDEF: ushort __uint16_t
TYPEDEF: int __int32_t
TYPEDEF: uint __uint32_t
TYPEDEF: longlong __int64_t
TYPEDEF: longlong __uint64_t
TYPEDEF: int int32_t
TYPEDEF: uint uint32_t
TYPEDEF: uint u_int32_t
TYPEDEF: longlong int64_t
TYPEDEF: ulonglong u_int64_t
TYPEDEF: __uint32_t __dev_t
TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint32_t mode_t

13
basis/unix/types/openbsd/openbsd.factor
View File

@ -3,19 +3,6 @@ IN: unix.types
! OpenBSD 4.2
TYPEDEF: short __int16_t
TYPEDEF: ushort __uint16_t
TYPEDEF: int __int32_t
TYPEDEF: uint __uint32_t
TYPEDEF: longlong __int64_t
TYPEDEF: longlong __uint64_t
TYPEDEF: int int32_t
TYPEDEF: uint u_int32_t
TYPEDEF: uint uint32_t
TYPEDEF: longlong int64_t
TYPEDEF: ulonglong u_int64_t
TYPEDEF: __uint32_t __dev_t
TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint32_t ino_t

5
basis/unix/types/types.factor
View File

@ -16,6 +16,11 @@ TYPEDEF: ushort uint16_t
TYPEDEF: uint uint32_t
TYPEDEF: ulonglong uint64_t
TYPEDEF: uchar u_int8_t
TYPEDEF: ushort u_int16_t
TYPEDEF: uint u_int32_t
TYPEDEF: ulonglong u_int64_t
TYPEDEF: char __int8_t
TYPEDEF: short __int16_t
TYPEDEF: int __int32_t

5
basis/unix/unix.factor
View File

@ -81,6 +81,7 @@ FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
FUNCTION: int chroot ( char* path ) ;
FUNCTION: int close ( int fd ) ;
FUNCTION: int closedir ( DIR* dirp ) ;
: close-file ( fd -- ) [ close ] unix-system-call drop ;
@ -136,6 +137,8 @@ FUNCTION: int shutdown ( int fd, int how ) ;
FUNCTION: int open ( char* path, int flags, int prot ) ;
FUNCTION: DIR* opendir ( char* path ) ;
: open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
C-STRUCT: utimbuf
@ -157,6 +160,8 @@ FUNCTION: int pipe ( int* filedes ) ;
FUNCTION: void* popen ( char* command, char* type ) ;
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
: PATH_MAX 1024 ; inline

2
basis/windows/errors/errors.factor
View File

@ -2,9 +2,9 @@ USING: kernel ;
IN: windows.errors
: ERROR_SUCCESS 0 ; inline
: ERROR_NO_MORE_FILES 18 ; inline
: ERROR_HANDLE_EOF 38 ; inline
: ERROR_BROKEN_PIPE 109 ; inline
: ERROR_ENVVAR_NOT_FOUND 203 ; inline
: ERROR_IO_INCOMPLETE 996 ; inline
: ERROR_IO_PENDING 997 ; inline

1
core/bootstrap/primitives.factor
View File

@ -434,7 +434,6 @@ tuple
{ "getenv" "kernel.private" }
{ "setenv" "kernel.private" }
{ "(exists?)" "io.files.private" }
{ "(directory)" "io.files.private" }
{ "gc" "memory" }
{ "gc-stats" "memory" }
{ "save-image" "memory" }

30
core/io/files/files-docs.factor
View File

@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories"
"Home directory:"
{ $subsection home }
"Directory listing:"
{ $subsection directory }
{ $subsection directory* }
{ $subsection directory-entries }
{ $subsection directory-files }
{ $subsection with-directory-files }
"Creating directories:"
{ $subsection make-directory }
{ $subsection make-directories }
@ -304,23 +305,22 @@ HELP: directory?
{ $values { "file-info" file-info } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "file-info" } " is a directory." } ;
HELP: (directory)
HELP: (directory-entries)
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "This is a low-level word, and user code should call " { $link directory } " instead." } ;
{ $notes "This is a low-level word, and user code should call one of the related words instead." } ;
HELP: directory
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
HELP: directory-entries
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
HELP: directory*
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
HELP: directory-files
{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
! HELP: file-modified
! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
HELP: with-directory-files
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
@ -329,10 +329,6 @@ HELP: resource-path
HELP: pathname
{ $class-description "Class of path name objects. Path name objects can be created by calling " { $link <pathname> } "." } ;
HELP: normalize-directory
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ;
HELP: normalize-path
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;

14
core/io/files/files-tests.factor
View File

@ -151,18 +151,24 @@ USE: debugger.threads
"delete-tree-test" temp-file delete-tree
] unit-test
[ { { "kernel" t } } ] [
[ { "kernel" } ] [
"core" resource-path [
"." directory [ first "kernel" = ] filter
"." directory-files [ "kernel" = ] filter
] with-directory
] unit-test
[ { { "kernel" t } } ] [
[ { "kernel" } ] [
"resource:core" [
"." directory [ first "kernel" = ] filter
"." directory-files [ "kernel" = ] filter
] with-directory
] unit-test
[ { "kernel" } ] [
"resource:core" [
[ "kernel" = ] filter
] with-directory-files
] unit-test
[ ] [
"copy-tree-test/a/b/c" temp-file make-directories
] unit-test

41
core/io/files/files.factor
View File

@ -235,19 +235,22 @@ HOOK: make-directory io-backend ( path -- )
]
} cond drop ;
! Directory listings
: fixup-directory ( path seq -- newseq )
[
dup string?
[ tuck append-path file-info directory? 2array ] [ nip ] if
] with map
[ first { "." ".." } member? not ] filter ;
TUPLE: directory-entry name type ;
: directory ( path -- seq )
normalize-directory dup (directory) fixup-directory ;
HOOK: >directory-entry os ( byte-array -- directory-entry )
: directory* ( path -- seq )
dup directory [ first2 >r append-path r> 2array ] with map ;
HOOK: (directory-entries) os ( path -- seq )
: directory-entries ( path -- seq )
normalize-path
(directory-entries)
[ name>> { "." ".." } member? not ] filter ;
: directory-files ( path -- seq )
directory-entries [ name>> ] map ;
: with-directory-files ( path quot -- )
[ "" directory-files ] prepose with-directory ; inline
! Touching files
HOOK: touch-file io-backend ( path -- )
@ -259,12 +262,10 @@ HOOK: delete-directory io-backend ( path -- )
: delete-tree ( path -- )
dup link-info type>> +directory+ = [
dup directory over [
[ first delete-tree ] each
] with-directory delete-directory
] [
delete-file
] if ;
[ [ [ delete-tree ] each ] with-directory-files ]
[ delete-directory ]
bi
] [ delete-file ] if ;
: to-directory ( from to -- from to' )
over file-name append-path ;
@ -303,9 +304,9 @@ DEFER: copy-tree-into
{
{ +symbolic-link+ [ copy-link ] }
{ +directory+ [
>r dup directory r> rot [
[ >r first r> copy-tree-into ] curry each
] with-directory
swap [
[ swap copy-tree-into ] with each
] with-directory-files
] }
[ drop copy-file ]
} case ;

2
core/sequences/sequences-docs.factor
View File

@ -398,7 +398,7 @@ HELP: filter
{ $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ;
HELP: filter-here
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } }
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } }
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
{ $side-effects "seq" } ;

2
extra/ftp/ftp.factor
View File

@ -59,5 +59,5 @@ TUPLE: ftp-response n strings parsed ;
3array " " join ;
: directory-list ( -- seq )
"" directory keys
"" directory-files
[ [ link-info ] keep file-info>string ] map ;

93
extra/html/parser/analyzer/analyzer.factor
View File

@ -3,7 +3,7 @@
USING: assocs html.parser kernel math sequences strings ascii
arrays generalizations shuffle unicode.case namespaces make
splitting http accessors io combinators http.client urls
urls.encoding fry ;
urls.encoding fry prettyprint ;
IN: html.parser.analyzer
TUPLE: link attributes clickable ;
@ -19,35 +19,34 @@ TUPLE: link attributes clickable ;
'[ _ [ second @ ] find-from rot drop swap 1+ ]
[ f 0 ] 2dip times drop first2 ; inline
: find-first-name ( str vector -- i/f tag/f )
[ >lower ] dip [ name>> = ] with find ; inline
: find-first-name ( vector string -- i/f tag/f )
>lower '[ name>> _ = ] find ; inline
: find-matching-close ( str vector -- i/f tag/f )
[ >lower ] dip
[ [ name>> = ] [ closing?>> ] bi and ] with find ; inline
: find-matching-close ( vector string -- i/f tag/f )
>lower
'[ [ name>> _ = ] [ closing?>> ] bi and ] find ; inline
: find-between* ( i/f tag/f vector -- vector )
pick integer? [
rot tail-slice
>r name>> r>
[ find-matching-close drop dup [ 1+ ] when ] keep
swap [ head ] [ first ] if*
: find-between* ( vector i/f tag/f -- vector )
over integer? [
[ tail-slice ] [ name>> ] bi*
dupd find-matching-close drop dup [ 1+ ] when
[ head ] [ first ] if*
] [
3drop V{ } clone
] if ; inline
: find-between ( i/f tag/f vector -- vector )
: find-between ( vector i/f tag/f -- vector )
find-between* dup length 3 >= [
[ rest-slice but-last-slice ] keep like
] when ; inline
: find-between-first ( string vector -- vector' )
[ find-first-name ] keep find-between ; inline
: find-between-first ( vector string -- vector' )
dupd find-first-name find-between ; inline
: find-between-all ( vector quot -- seq )
[ [ [ closing?>> not ] bi and ] curry find-all ] curry
[ [ >r first2 r> find-between* ] curry map ] bi ; inline
dupd
'[ _ [ closing?>> not ] bi and ] find-all
[ first2 find-between* ] with map ;
: remove-blank-text ( vector -- vector' )
[
@ -61,27 +60,40 @@ TUPLE: link attributes clickable ;
[ [ [ blank? ] trim ] change-text ] when
] map ;
: find-by-id ( id vector -- vector )
[ attributes>> "id" swap at = ] with filter ;
: find-by-id ( vector id -- vector' )
'[ attributes>> "id" at _ = ] find ;
: find-by-class ( vector id -- vector' )
'[ attributes>> "class" at _ = ] find ;
: find-by-class ( id vector -- vector )
[ attributes>> "class" swap at = ] with filter ;
: find-by-name ( vector string -- vector )
>lower '[ name>> _ = ] find ;
: find-by-name ( str vector -- vector )
[ >lower ] dip [ name>> = ] with filter ;
: find-by-id-between ( vector string -- vector' )
dupd
'[ attributes>> "id" swap at _ = ] find find-between* ;
: find-by-class-between ( vector string -- vector' )
dupd
'[ attributes>> "class" swap at _ = ] find find-between* ;
: find-by-class-id-between ( vector class id -- vector' )
'[
[ attributes>> "class" swap at _ = ]
[ attributes>> "id" swap at _ = ] bi and
] dupd find find-between* ;
: find-by-attribute-key ( key vector -- vector )
[ >lower ] dip
[ attributes>> at ] with filter
sift ;
: find-by-attribute-key ( vector key -- vector' )
>lower
[ attributes>> at _ = ] filter sift ;
: find-by-attribute-key-value ( value key vector -- vector )
[ >lower ] dip
: find-by-attribute-key-value ( vector value key -- vector' )
>lower
[ attributes>> at over = ] with filter nip
sift ;
: find-first-attribute-key-value ( value key vector -- i/f tag/f )
[ >lower ] dip
: find-first-attribute-key-value ( vector value key -- i/f tag/f )
>lower
[ attributes>> at over = ] with find rot drop ;
: tag-link ( tag -- link/f )
@ -121,9 +133,9 @@ TUPLE: link attributes clickable ;
swap [ >r first2 r> find-between* ] curry map
[ [ name>> { "form" "input" } member? ] filter ] map ;
: find-html-objects ( string vector -- vector' )
[ find-opening-tags-by-name ] keep
[ [ first2 ] dip find-between* ] curry map ;
: find-html-objects ( vector string -- vector' )
dupd find-opening-tags-by-name
[ first2 find-between* ] curry map ;
: form-action ( vector -- string )
[ name>> "form" = ] find nip
@ -150,3 +162,12 @@ TUPLE: link attributes clickable ;
: query>assoc* ( str -- hash )
"?" split1 nip query>assoc ;
: html-class? ( tag string -- ? )
swap attributes>> "class" swap at = ;
: html-id? ( tag string -- ? )
swap attributes>> "id" swap at = ;
: opening-tag? ( tag -- ? )
closing?>> not ;

4
extra/io/paths/paths.factor
View File

@ -7,7 +7,7 @@ IN: io.paths
TUPLE: directory-iterator path bfs queue ;
: qualified-directory ( path -- seq )
dup directory [ first2 [ append-path ] dip 2array ] with map ;
dup directory-files [ append-path ] with map ;
: push-directory ( path iter -- )
[ qualified-directory ] dip [
@ -21,7 +21,7 @@ TUPLE: directory-iterator path bfs queue ;
: next-file ( iter -- file/f )
dup queue>> deque-empty? [ drop f ] [
dup queue>> pop-back first2
dup queue>> pop-back dup link-info directory?
[ over push-directory next-file ] [ nip ] if
] if ;

2
extra/shell/shell.factor
View File

@ -39,7 +39,7 @@ METHOD: expand { variable-expr } expr>> os-env ;
METHOD: expand { glob-expr }
expr>>
dup "*" =
[ drop current-directory get directory [ first ] map ]
[ drop current-directory get directory-files ]
[ ]
if ;

25
extra/webapps/wiki/wiki.factor
View File

@ -374,15 +374,16 @@ M: revision feed-entry-url id>> revision-url ;
{ wiki "wiki-common" } >>template ;
: init-wiki ( -- )
"resource:extra/webapps/wiki/initial-content" directory* keys
[
dup file-name ".txt" ?tail [
swap ascii file-contents
f <revision>
swap >>content
swap >>title
"slava" >>author
now >>date
add-revision
] [ 2drop ] if
] each ;
"resource:extra/webapps/wiki/initial-content" [
[
dup ".txt" ?tail [
swap ascii file-contents
f <revision>
swap >>content
swap >>title
"slava" >>author
now >>date
add-revision
] [ 2drop ] if
] each
] with-directory-files ;

3
vm/os-freebsd.h
View File

@ -7,6 +7,3 @@ extern int getosreldate(void);
#ifndef KERN_PROC_PATHNAME
#define KERN_PROC_PATHNAME 12
#endif
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)

3
vm/os-linux.h
View File

@ -1,8 +1,5 @@
#include <sys/syscall.h>
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
int inotify_init(void);
int inotify_add_watch(int fd, const char *name, u32 mask);
int inotify_rm_watch(int fd, u32 wd);

2
vm/os-macosx.h
View File

@ -1,8 +1,6 @@
#define DLLEXPORT __attribute__((visibility("default")))
#define FACTOR_OS_STRING "macosx"
#define NULL_DLL "libfactor.dylib"
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
void init_signals(void);
void early_init(void);

2
vm/os-openbsd.h
View File

@ -1,2 +0,0 @@
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)

2
vm/os-solaris.h
View File

@ -1,2 +0,0 @@
#define UNKNOWN_TYPE_P(file) 1
#define DIRECTORY_P(file) 0

38
vm/os-unix.c
View File

@ -61,44 +61,6 @@ DEFINE_PRIMITIVE(existsp)
box_boolean(stat(unbox_char_string(),&sb) >= 0);
}
/* Allocates memory */
CELL parse_dir_entry(struct dirent *file)
{
CELL name = tag_object(from_char_string(file->d_name));
if(UNKNOWN_TYPE_P(file))
return name;
else
{
CELL dirp = tag_boolean(DIRECTORY_P(file));
return allot_array_2(name,dirp);
}
}
DEFINE_PRIMITIVE(read_dir)
{
DIR* dir = opendir(unbox_char_string());
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
if(dir != NULL)
{
struct dirent* file;
while((file = readdir(dir)) != NULL)
{
CELL pair = parse_dir_entry(file);
GROWABLE_ARRAY_ADD(result,pair);
}
closedir(dir);
}
UNREGISTER_ROOT(result);
GROWABLE_ARRAY_TRIM(result);
dpush(result);
}
F_SEGMENT *alloc_segment(CELL size)
{
int pagesize = getpagesize();

43
vm/os-windows.c
View File

@ -87,21 +87,6 @@ const F_CHAR *vm_executable_path(void)
return safe_strdup(full_path);
}
void find_file_stat(F_CHAR *path)
{
// FindFirstFile is the only call that can stat c:\pagefile.sys
WIN32_FIND_DATA st;
HANDLE h;
if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st)))
dpush(F);
else
{
FindClose(h);
dpush(T);
}
}
DEFINE_PRIMITIVE(existsp)
{
BY_HANDLE_FILE_INFORMATION bhfi;
@ -136,34 +121,6 @@ DEFINE_PRIMITIVE(existsp)
CloseHandle(h);
}
DEFINE_PRIMITIVE(read_dir)
{
HANDLE dir;
WIN32_FIND_DATA find_data;
F_CHAR *path = unbox_u16_string();
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
{
do
{
CELL name = tag_object(from_u16_string(find_data.cFileName));
CELL dirp = tag_boolean(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
CELL pair = allot_array_2(name,dirp);
GROWABLE_ARRAY_ADD(result,pair);
}
while (FindNextFile(dir, &find_data));
FindClose(dir);
}
UNREGISTER_ROOT(result);
GROWABLE_ARRAY_TRIM(result);
dpush(result);
}
F_SEGMENT *alloc_segment(CELL size)
{
char *mem;

2
vm/platform.h
View File

@ -55,7 +55,6 @@
#endif
#elif defined(__OpenBSD__)
#define FACTOR_OS_STRING "openbsd"
#include "os-openbsd.h"
#if defined(FACTOR_X86)
#include "os-openbsd-x86.32.h"
@ -102,7 +101,6 @@
#error "Unsupported Solaris flavor"
#endif
#include "os-solaris.h"
#else
#error "Unsupported OS"
#endif

1
vm/primitives.c
View File

@ -57,7 +57,6 @@ void *primitives[] = {
primitive_getenv,
primitive_setenv,
primitive_existsp,
primitive_read_dir,
primitive_gc,
primitive_gc_stats,
primitive_save_image,