1 Filename
share/lib/std/io/filename.flx
class Filename_class[os] {
virtual fun sep: 1 -> string;
virtual fun is_absolute_filename : string -> bool;
virtual fun root_subdir : string -> string;
virtual fun executable_extension : 1 -> string;
virtual fun static_object_extension: 1 -> string;
virtual fun dynamic_object_extension: 1 -> string;
virtual fun static_library_extension: 1 -> string;
virtual fun dynamic_library_extension: 1 -> string;
fun split1(s:string)=> match find_last_of(s,#sep) with
| Some pos =>
if pos==0uz then #sep else s.[to pos] endif,
s.[pos+#sep.len to]
| #None => "",s
endmatch
;
private fun split(s:string, acc:List::list[string]):List::list[string]=>
let d,b = split1 s in
if d == "" then List::Cons(b,acc)
elif d == #sep then List::Cons(d, List::Cons(b,acc))
else split (d, List::Cons (b, acc))
endif
;
fun split(s:string)=> split (s, List::Empty[string]);
fun join(p:string, b:string)=>
if p == "" then b
elif p == #sep then p+b
elif p.[-1] == #sep.[0] then p+b
else p+#sep+b
endif
;
fun basename(s:string)=> match split1(s) with | _,b => b endmatch;
fun dirname(s:string)=> match split1(s) with | d,_ => d endmatch;
fun directories (s:string) : list[string] =>
let d,b = split1 s in
if d == "" then Empty[string]
elif d == #sep then Empty[string]
else directories d + d
;
fun join(a:string, b:string, c:string)=> join(join(a,b),c);
fun join(a:string, b:string, c:string,d:string)=> join(join(join(a,b),c),d);
fun join(x:string) (y:string) => join(x,y);
fun join(ps: List::list[string])=> List::fold_left Filename::join of (string) "" ps;
fun split_extension (s:string): string * string = {
var n = s.len;
if n > 0uz do
for var i in s.len - 1uz downto 0uz do
var ch = s.[i];
if ch == char "." return s.[to i],s.[i to];
if ch == char #sep return s,"";
done
done
return s,"";
}
fun strip_extension (s:string) => s.split_extension.0;
fun get_extension (s:string) => s.split_extension.1;
}
class Win32Filename
{
inherit Filename_class[Win32];
instance Filename_class[Win32] {
fun sep() => "\\";
fun executable_extension ()=> ".exe";
fun static_object_extension() => ".obj";
fun dynamic_object_extension() => ".obj";
fun static_library_extension() => ".lib";
fun dynamic_library_extension() => ".dll";
fun is_absolute_filename (f:string) =>
f.[0] == "\\".char or
f.[1] == ":".char and f.[2] == "\\".char
;
fun root_subdir (s:string) => "C:\\"+s;
}
}
class OsxFilename
{
inherit Filename_class[Osx];
instance Filename_class[Osx] {
fun sep() => "/";
fun executable_extension ()=> "";
fun static_object_extension() => ".o";
fun dynamic_object_extension() => ".os";
fun static_library_extension() => ".a";
fun dynamic_library_extension() => ".dylib";
fun is_absolute_filename (f:string) => f.[0] == "/";
fun root_subdir (s:string) => "/"+s;
}
}
class PosixFilename
{
inherit Filename_class[Posix];
instance Filename_class[Posix] {
fun sep() => "/";
fun executable_extension ()=> "";
fun static_object_extension() => ".o";
fun dynamic_object_extension() => ".os";
fun static_library_extension() => ".a";
fun dynamic_library_extension() => ".so";
fun is_absolute_filename (f:string) => f.[0] == "/";
fun root_subdir (s:string) => "/"+s;
}
}
class Filename
{
if PLAT_WIN32 do
inherit Win32Filename;
elif PLAT_MACOSX do
inherit OsxFilename;
else
inherit PosixFilename;
done
}
2 Filestat
share/lib/std/io/filestat.flx
class FileStat_class[OS,stat_t, mode_t]
{
virtual proc stat: string * &stat_t * ∫
virtual proc utime: string * double * double * ∫
virtual gen chmod: string * mode_t -> int;
virtual gen umask: mode_t -> mode_t;
variant file_type_t =
| PIPE
| STREAM
| DIRECTORY
| BLOCK
| REGULAR
| SYMLINK
| SOCKET
| INDETERMINATE
| NONEXISTANT
| NOPERMISSION
;
virtual fun file_type: &stat_t -> file_type_t;
gen stat(file: string, statbuf:&stat_t) = {
var res: int;
stat(file, statbuf, &res);
return res == 0;
}
fun mtime: &stat_t -> double = "(double)($1->st_mtime)";
fun ctime: &stat_t -> double = "(double)($1->st_ctime)";
fun filetime(f:string):double =
{
var b: stat_t;
var err:int;
stat(f,&b,&err);
return if err == 0 then mtime (&b) else 0.0 endif;
}
gen utime(f:string, a:double, m:double): bool = {
var r:int;
utime(f,a,m,&r);
return r == 0;
}
gen utime(f:string, t:double) => utime(f,t,t);
fun fileexists(f:string):bool=> filetime f != 0.0;
fun filetype(f:string):file_type_t =
{
var b:stat_t;
var err:int;
stat(f,&b,&err);
return
if err == 0 then file_type (&b)
elif errno == EACCES then NOPERMISSION
elif errno == ENOENT then NONEXISTANT
else INDETERMINATE
endif
;
}
fun past_time () => -1.0;
fun future_time () => double(ulong(-1));
fun strfiletime0 (x:double) = {
return
if x == #past_time then "BIG BANG"
elif x == #future_time then "BIG CRUNCH"
else fmt (x, fixed (0,3))
endif
;
}
fun strfiletime (x:double) = {
assert x != 0.0;
return strfiletime0 x;
}
fun dfiletime(var f:string, dflt:double)=
{
var x = FileStat::filetime (f);
x = if x == 0.0 then dflt else x endif;
return x;
}
}
class FileStat {
if PLAT_WIN32 do
inherit Win32FileStat;
else
inherit PosixFileStat;
done
}
3 Posix FileStat
share/lib/std/posix/filestat.flx
class PosixFileStat
{
pod type stat_t = "struct stat" requires Posix_headers::sys_stat_h;
pod type mode_t = "mode_t" requires Posix_headers::sys_types_h;
instance Bits[mode_t] {}
instance Eq[mode_t] { fun == : mode_t * mode_t -> bool = "$1==$2"; }
open Eq[mode_t];
open Bits[mode_t];
const S_IFMT : mode_t;
const S_IFIFO : mode_t;
const S_IFCHR : mode_t;
const S_IFDIR : mode_t;
const S_IFBLK : mode_t;
const S_IFREG : mode_t;
const S_IFLNK : mode_t;
const S_IFSOCK: mode_t;
const S_IRWXU : mode_t;
const S_IRUSR : mode_t;
const S_IWUSR : mode_t;
const S_IXUSR : mode_t;
const S_IRWXG : mode_t;
const S_IRGRP : mode_t;
const S_IWGRP : mode_t;
const S_IXGRP : mode_t;
const S_IRWXO : mode_t;
const S_IROTH : mode_t;
const S_IWOTH : mode_t;
const S_IXOTH : mode_t;
const S_ISUID : mode_t;
const S_ISGID : mode_t;
const S_ISVXT : mode_t;
val access_mask = S_IXOTH \| S_IXGRP \| S_IXUSR;
fun raw_mode: &stat_t -> mode_t = "$1->st_mode";
fun file_type(m:mode_t)=>m \& S_IFMT;
fun file_perm(m:mode_t)=>m \& ~S_IFMT;
ctor uint: mode_t = "(unsigned int)$1";
inherit FileStat_class[Posix, stat_t, mode_t];
instance FileStat_class[Posix, stat_t, mode_t]
{
proc stat: string * &stat_t * &int = "*$3=stat($1.c_str(),$2);";
proc utime: string * double * double * &int =
"""
{
utimbuf u;
u.actime=(time_t)$2;
u.modtime=(time_t)$3;
*$4 = utime($1.c_str(),&u);
}
"""
requires Posix_headers::utime_h;
gen chmod: string * mode_t -> int = "chmod($1.c_str(),$2)" requires Posix_headers::sys_stat_h;
gen umask: mode_t -> mode_t = "umask($1)";
fun file_type (s:&stat_t): file_type_t =>
let m = file_type$ raw_mode s in
if m == S_IFIFO then PIPE
elif m == S_IFCHR then STREAM
elif m == S_IFDIR then DIRECTORY
elif m == S_IFBLK then BLOCK
elif m == S_IFREG then REGULAR
elif m == S_IFLNK then SYMLINK
elif m == S_IFSOCK then SOCKET
else INDETERMINATE
endif
;
}
}
4 Win32 FileStat
share/lib/std/win32/filestat.flx
class Win32FileStat
{
pod type mode_t = "int";
pod type stat_t = "struct __stat64" requires Posix_headers::sys_stat_h;
instance Bits[mode_t] {}
instance Eq[mode_t] { fun == : mode_t * mode_t -> bool = "$1==$2"; }
open Eq[mode_t];
open Bits[mode_t];
const _S_IFMT : mode_t;
const _S_IFDIR : mode_t;
const _S_IFREG : mode_t;
const _S_IWRITE: mode_t;
const _S_IREAD : mode_t;
val access_mask = _S_IREAD \| _S_IWRITE;
fun raw_mode: &stat_t -> mode_t = "$1->st_mode";
fun file_type(m:mode_t)=>m \& _S_IFMT;
fun file_perm(m:mode_t)=>m \& ~_S_IFMT;
ctor uint: mode_t = "(unsigned int)$1";
inherit FileStat_class[Win32, stat_t, mode_t];
instance FileStat_class[Win32, stat_t, mode_t]
{
proc stat: string * &stat_t * &int = "*$3=_stat64($1.c_str(),$2);";
proc utime: string * double * double * &int =
"""
{
__utimbuf64 u;
u.actime=(time_t)$2;
u.modtime=(time_t)$3;
*$4 = _utime64($1.c_str(),&u);
}
"""
requires Win32_headers::sys_utime_h;
gen chmod: string * mode_t -> int = "_chmod($1.c_str(),$2)" requires Win32_headers::io_h;
gen umask: mode_t -> mode_t = "_umask($1)";
fun file_type (s:&stat_t): file_type_t =>
let m = file_type$ raw_mode s in
if m == _S_IFDIR then DIRECTORY
elif m == _S_IFREG then REGULAR
else INDETERMINATE
endif
;
}
}
5 File Syetem
share/lib/std/io/filesystem.flx
class FileSystem_class[os]
{
}
class FileSystem {
if PLAT_WIN32 do
inherit Win32FileSystem;
else
inherit PosixFileSystem;
done
proc unlink(f:string)
{
proc aux (d:string) (b:string)
{
if b == "." or b == ".." return;
var f = if d == "" then b else Filename::join (d,b);
match FileStat::filetype f with
| #PIPE => ;
| #STREAM => ;
| #DIRECTORY =>
match Directory::filesin f with
| #None => ;
| Some files =>
for file in files do
aux f file;
done
C_hack::ignore$ Directory::unlink_empty_dir f;
endmatch;
| #BLOCK => ;
| #REGULAR => C_hack::ignore$ unlink_file f;
| #SYMLINK => C_hack::ignore$ unlink_file f;
| #SOCKET => ;
| #INDETERMINATE => ;
| #NONEXISTANT => ;
| #NOPERMISSION => ;
endmatch;
}
aux "" f;
}
proc rm (f:string) => unlink f;
fun find_in_path(x:string, path:list[string]):opt[string]=>
match path with
| #Empty => None[string]
| Cons (d,t) =>
let p = Filename::join(d,x) in
match FileStat::fileexists p with
| true => Some p
| false => find_in_path (x,t)
endmatch
endmatch
;
fun regfilesin(dname:string, re:string): list[string] => regfilesin(dname, Re2::RE2 re);
fun regfilesin(dname:string, re:RE2): list[string] = {
var foundfiles = Empty[string];
proc rfi(dname2: string) {
if dname2 == "." or dname2 == ".." return;
var newpath = if dname2 == "" then dname else Filename::join (dname,dname2);
var newfiles = Directory::filesin(newpath);
match newfiles with
| #None => return;
| Some files =>
for f in files do
if f == "." or f == ".." do ;
else
var d = Filename::join (dname2,f);
var fullpath = Filename::join (dname,d);
var t = FileStat::filetype fullpath;
match t with
| #REGULAR =>
var result = d in re;
if result do
foundfiles = Cons (d, foundfiles);
done
| #DIRECTORY =>
rfi (d);
| _ => ;
endmatch;
done
done
endmatch;
}
rfi ("");
return rev foundfiles;
}
}
6 Posix File Syetem
share/lib/std/posix/filesystem.flx
class PosixFileSystem
{
pod type file_perm_t = "int" requires Posix_headers::fcntl_h;
const O_RDONLY : file_perm_t;
const O_WRONLY : file_perm_t;
const O_RDWR : file_perm_t;
const O_NONBLOCK : file_perm_t;
const O_APPEND : file_perm_t;
const O_CREAT : file_perm_t;
const O_TRUNC : file_perm_t;
const O_EXCL : file_perm_t;
const O_SHLOCK : file_perm_t;
const O_EXLOCK : file_perm_t;
const O_NOFOLLOW : file_perm_t;
const O_SYMLINK : file_perm_t;
const O_EVTONLY : file_perm_t;
fun \& : file_perm_t * file_perm_t -> file_perm_t = "$1&$2";
fun \| : file_perm_t * file_perm_t -> file_perm_t = "$1|$2";
pod type posix_file = "int" requires Posix_headers::unistd_h;
fun valid: posix_file -> bool = "$1 != -1";
ctor int : posix_file = "$1";
const fd0 : posix_file = "0";
const fd1 : posix_file = "1";
const fd2 : posix_file = "2";
gen open: string * file_perm_t * PosixFileStat::mode_t -> posix_file = "::open($1.c_str(), $2, $3)";
gen open: string * file_perm_t -> posix_file = "::open($1.c_str(), $2)";
gen ropen: string -> posix_file = '::open($1.c_str(), O_RDONLY,0)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
gen wopen: string -> posix_file = '::open($1.c_str(), O_WRONLY | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
gen rwopen: string -> posix_file = '::open($1.c_str(), O_RDWR,0)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
gen creat: string * PosixFileStat::mode_t-> posix_file = '::open($1.c_str(), O_WRONLY | O_CREAT | O_TRUNC, $2)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
gen close: posix_file -> int = "::close($1)";
gen read: posix_file * &char * size -> size = "::read($1, $2, $3)";
gen write: posix_file * &char * size -> size = "::write($1, (void*)$2, $3)/*posix write*/" requires Posix_headers::unistd_h;
gen dup: posix_file -> posix_file = "::dup($1)" requires Posix_headers::unistd_h;
gen dup2: posix_file * posix_file -> posix_file = "::dup2($1,$2)" requires Posix_headers::unistd_h;
header piper_def = """
struct _piper_hack { int i; int o; };
""";
body piper_def = """
_piper_hack _piper() {
_piper_hack p;
pipe((int*)(void*)&p);
return p;
}
""" requires Posix_headers::unistd_h;
private cstruct _piper_hack { i:posix_file; o:posix_file; };
private gen _piper: 1 -> _piper_hack requires piper_def;
private fun _mkpair (x: _piper_hack) => x.i, x.o;
gen pipe () => _mkpair #_piper;
gen fdopen_input: posix_file -> ifile = '::fdopen($1,"r")';
gen fdopen_output: posix_file -> ofile = '::fdopen($1,"w")';
gen unlink_file: string -> int = "::unlink($1.c_str())"
requires Posix_headers::unistd_h;
gen rename_file: string * string -> int = "::rename($1.c_str(),$2.c_str())"
requires Posix_headers::unistd_h;
gen filecopy(src: string, dst: string) : bool =
{
if Env::getenv ("FLX_REPORT_FILECOPY") != "" do
eprintln$ "[PosixFileSystem::filecopy] '" + src + "' -> '" + dst+ "'";
done
val now = Time::time();
var stat_buf: PosixFileStat::stat_t;
if not PosixFileStat::stat (src, &stat_buf) do
eprintln$ "[PosixFileSystem::filecopy] Can't stat source file " + src;
return false;
done;
val permissions = PosixFileStat::file_perm$ PosixFileStat::raw_mode (&stat_buf);
val last_modification = PosixFileStat::filetime(src);
var fsrc = open (src,O_RDONLY );
if not valid fsrc do
eprintln$ "[PosixFileSystem::filecopy] Bad src file in Filesystem::filecopy " + src;
return false;
done
var fdst = open (dst,O_WRONLY \| O_CREAT \| O_TRUNC, permissions);
if not valid fdst do
eprintln$ "[PosixFileSystem::filecopy] Bad dst file in Filesystem::filecopy " + dst + ", Error: " + str errno + "=" + #strerror;
return false;
done
bsiz := size (4096 * 1024);
var buffer = C_hack::cast[&char] (Memory::malloc(bsiz));
var bread = read (fsrc, buffer, bsiz);
while bread > size 0 do
var bwrite = write (fdst,buffer,bread);
if bread != bwrite do
if bwrite.int == -1 do
eprintln$
"[PosixFileSystem::filecopy] Dest des = " + str fdst.int+ " "+
"Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
" failed with errno = " + str errno + ": " + strerror()
;
else
eprintln$
"[PosixFileSystem::filecopy] Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
" failed with " + str bwrite + " only copied!"
;
done
done
bread = read (fsrc, buffer, bsiz);
done
var res = close fsrc;
if res != 0 do
eprintln$ "[PosixFileSystem::filecopy] close on src " + src + " failed: " + str errno + "=" + #strerror;
done
res = close fdst;
if res != 0 do
eprintln$ "[PosixFileSystem::filecopy] close on dst " + dst + " failed: " + str errno + "=" + #strerror;
done
C_hack::ignore(PosixFileStat::utime(dst,now,last_modification));
Memory::free(C_hack::cast[address] buffer);
return true;
}
body tmpnam = """
std::string flx_tmpnam() {
char tmpn[] = "/tmp/flx_XXXXXX";
close(mkstemp(tmpn));
return std::string(tmpn);
}
""" requires header '#include <unistd.h>';
gen tmp_filename: 1 -> string = "flx_tmpnam()" requires tmpnam;
}
7 Win32 File Syetem
share/lib/std/win32/filesystem.flx
class Win32FileSystem
{
pod type file_perm_t = "int" requires Posix_headers::fcntl_h;
const _O_BINARY : file_perm_t;
const _O_RDONLY : file_perm_t;
const _O_WRONLY : file_perm_t;
const _O_RDWR : file_perm_t;
const _O_NONBLOCK : file_perm_t;
const _O_APPEND : file_perm_t;
const _O_CREAT : file_perm_t;
const _O_TRUNC : file_perm_t;
const _O_EXCL : file_perm_t;
const _O_SHLOCK : file_perm_t;
const _O_EXLOCK : file_perm_t;
const _O_NOFOLLOW : file_perm_t;
const _O_SYMLINK : file_perm_t;
const _O_EVTONLY : file_perm_t;
fun \& : file_perm_t * file_perm_t -> file_perm_t = "$1&$2";
fun \| : file_perm_t * file_perm_t -> file_perm_t = "$1|$2";
pod type posix_file = "int" requires Win32_headers::io_h;
fun valid: posix_file -> bool = "$1 != -1";
ctor int : posix_file = "$1";
const fd0 : posix_file = "0";
const fd1 : posix_file = "1";
const fd2 : posix_file = "2";
gen open: string * file_perm_t * Win32FileStat::mode_t -> posix_file = "::_open($1.c_str(), $2, $3)";
gen open: string * file_perm_t -> posix_file = "::_open($1.c_str(), $2)";
gen ropen: string -> posix_file = '::open($1.c_str(), _O_RDONLY | _O_BINARY,0)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
gen wopen: string -> posix_file = '::open($1.c_str(), _O_WRONLY | _O_BINARY | _O_CREAT | _O_TRUNC, S_IRUSR | S_IWUSR)' requires Win32_headers::io_h, Posix_headers::sys_stat_h;
gen rwopen: string -> posix_file = '::open($1.c_str(), _O_RDWR | _O_BINARY,0)' requires Win32_headers::io_h, Posix_headers::sys_stat_h;
gen creat: string * Win32FileStat::mode_t-> posix_file = 'open($1.c_str(), _O_WRONLY | _O_BINARY | _O_CREAT | _O_TRUNC, $2)' requires Win32_headers::io_h, Posix_headers::sys_stat_h;
gen close: posix_file -> int = "::_close($1)";
gen read: posix_file * &char * size -> size = "::read($1, $2, $3)";
gen write: posix_file * &char * size -> size = "::write($1, $2, $3)";
gen dup: posix_file -> posix_file = "::dup($1)" requires Win32_headers::io_h;
gen dup2: posix_file * posix_file -> posix_file = "::dup2($1,$2)" requires Win32_headers::io_h;
header piper_def = """
struct _piper_hack { int i; int o; };
""";
body piper_def = """
_piper_hack _piper() {
_piper_hack p;
pipe((int*)(void*)&p);
return p;
}
""" requires Posix_headers::unistd_h;
private cstruct _piper_hack { i:posix_file; o:posix_file; };
private gen _piper: 1 -> _piper_hack requires piper_def;
private fun _mkpair (x: _piper_hack) => x.i, x.o;
gen pipe () => _mkpair #_piper;
gen fdopen_input: posix_file -> ifile = '::fdopen($1,"r")';
gen fdopen_output: posix_file -> ofile = '::fdopen($1,"w")';
gen unlink_file: string -> int = "::unlink($1.c_str())";
gen rename_file: string * string -> int = "::rename($1.c_str(),$2.c_str())";
gen filecopy(src: string, dst: string) : bool =
{
if Env::getenv ("FLX_REPORT_FILECOPY") != "" do
eprintln$ "[Win32FileSystem::filecopy] '" + src + "' -> '" + dst+ "'";
done
val now = Time::time();
var stat_buf: Win32FileStat::stat_t;
if not Win32FileStat::stat (src, &stat_buf) do
eprintln$ "Can't stat source file " + src;
return false;
done;
val permissions = Win32FileStat::file_perm$ Win32FileStat::raw_mode (&stat_buf);
val last_modification = Win32FileStat::filetime(src);
var fsrc = open (src,_O_RDONLY \| _O_BINARY);
if not valid fsrc do
eprintln$ " Bad src file in Filesystem::filecopy " + src;
return false;
done
var fdst = open (dst,_O_WRONLY \| _O_BINARY \| _O_CREAT \| _O_TRUNC, permissions);
if not valid fdst do
eprintln$ " Bad dst file in Filesystem::filecopy " + dst + ", Error: " + str errno + "=" + #strerror;
return false;
done
bsiz := size (4096 * 1024);
var buffer = C_hack::cast[&char] (Memory::malloc(bsiz));
var bread = read (fsrc, buffer, bsiz);
while bread > size 0 do
var bwrite = write (fdst,buffer,bread);
if bread != bwrite do
if bwrite.int == -1 do
eprintln$
"Dest des = " + str fdst.int+ " "+
"Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
" failed with errno = " + str errno + ": " + strerror()
;
else
eprintln$
"Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
" failed with " + str bwrite + " only copied!"
;
done
done
bread = read (fsrc, buffer, bsiz);
done
var res = close fsrc;
if res != 0 do
eprintln$ "In filesystem::filecopy close on src " + src + " failed: " + str errno + "=" + #strerror;
done
res = close fdst;
if res != 0 do
eprintln$ "In filesystem::filecopy close on dst " + dst + " failed: " + str errno + "=" + #strerror;
done
C_hack::ignore(Win32FileStat::utime(dst,now,last_modification));
Memory::free(C_hack::cast[address] buffer);
return true;
}
body tmpnam = """
std::string flx_tmpnam() {
char tmpn[] = "/tmp/flx_XXXXXX";
close(mkstemp(tmpn));
return std::string(tmpn);
}
""" requires header '#include <unistd.h>';
gen tmp_filename: 1 -> string = "flx_tmpnam()" requires tmpnam;
}
8 Directory
share/lib/std/io/directory.flx
class Directory_class[os,mode_t]
{
virtual gen mkdir: string * mode_t -> int;
virtual gen mkdir: string -> int;
virtual proc mkdirs: string;
virtual gen unlink_empty_dir: string -> int;
virtual fun filesin:string -> opt[List::list[string]];
virtual fun getcwd: 1 -> string;
virtual fun mk_absolute_filename: string -> string;
}
class Directory {
if PLAT_WIN32 do
inherit Win32Directory;
else
inherit PosixDirectory;
done
}
9 Posix Directory Services
share/lib/std/posix/directory.flx
class PosixDirectory
{
type dirent_t = "struct dirent*" requires Posix_headers::dirent_h;
type DIR_t = "DIR*" requires Posix_headers::dirent_h;
proc opendir: string * &DIR_t = "*$2=::opendir($1.c_str());";
fun isNULL: DIR_t -> bool = "$1==0";
fun isNULL: dirent_t -> bool = "$1==0";
proc readdir: DIR_t * dirent_t * &dirent_t * &int = "*$4=readdir_r($1, $2, $3);";
proc closedir: DIR_t = "::closedir($1);";
fun filename: dirent_t -> string = "::std::string($1->d_name)";
private fun getcwd: +char * size -> +char = "::getcwd($1,$2)" requires Posix_headers::unistd_h;
inherit Directory_class[Posix, PosixFileStat::mode_t];
instance Directory_class[Posix, PosixFileStat::mode_t] {
gen mkdir: string * PosixFileStat::mode_t -> int = "::mkdir($1.c_str(), $2)" requires Posix_headers::sys_stat_h;
gen mkdir: string -> int = "::mkdir($1.c_str(), 0777)" requires Posix_headers::sys_stat_h;
proc mkdirs (s:string)
{
if s == "" or s == "." or s == ".." or s == "/" do
return;
done
mkdirs$ Filename::dirname s;
C_hack::ignore$ mkdir s;
}
gen unlink_empty_dir : string -> int = "::rmdir ($1.c_str())" requires Posix_headers::unistd_h;
fun getcwd():string = {
var b: array[char,1024];
var p = getcwd((&b).stl_begin,size 1024);
return if C_hack::isNULL p then "" else string p endif;
}
fun mk_absolute_filename(s:string) =>
if PosixFilename::is_absolute_filename s then s else
#getcwd + "/" + s
;
fun filesin(dname:string): opt[List::list[string]] = {
var d:DIR_t;
var e: dirent_t = C_hack::cast[dirent_t]$ Memory::malloc 5000;
var eret = e;
var err:int = 0;
var files = List::Empty[string];
opendir(dname,&d);
if isNULL d do
println "Error opening dir";
Memory::free$ C_hack::cast[address] e;
return None[List::list[string]];
else
next:>
readdir(d,e,&eret, &err);
if err != 0 do
println "Error reading dir"; fflush;
closedir d;
Memory::free$ C_hack::cast[address] e;
return None[List::list[string]];
elif isNULL eret do
closedir d;
Memory::free$ C_hack::cast[address] e;
return Some files;
else
assert err == 0;
files += filename e;
goto next;
done
done
}
}
}
10 Win32 Directory Services
share/lib/std/win32/directory.flx
class Win32Directory
{
type DIR_t = "intptr_t" requires Win32_headers::io_h ;
type FINDDATA_t = "struct _finddata_t" requires Win32_headers::io_h ;
proc findfirst: string * &FINDDATA_t * &DIR_t = "*$3=::_findfirst($1.c_str(), $2);" ;
proc findnext: DIR_t * &FINDDATA_t * &int = "*$3=::_findnext($1, $2);" ;
proc findclose : DIR_t = "::_findclose($1);" ;
fun findfailed : DIR_t -> bool = "int($1) == -1" ;
fun filename : FINDDATA_t -> string = "::std::string($1.name)" ;
private fun getcwd: +char * size -> +char = "::_getcwd($1,(int)$2)" requires Win32_headers::direct_h;
inherit Directory_class[Win32, Win32FileStat::mode_t];
instance Directory_class[Win32, Win32FileStat::mode_t]
{
gen mkdir: string * Win32FileStat::mode_t -> int = "::_mkdir($1.c_str())" requires Win32_headers::direct_h;
gen mkdir: string -> int = "::_mkdir($1.c_str())" requires Win32_headers::direct_h;
proc mkdirs (s:string)
{
if s == "" or s == "." or s == ".." or s.[-1] == char "\\" do
return;
done
mkdirs$ Win32Filename::dirname s;
C_hack::ignore$ mkdir s;
}
gen unlink_empty_dir: string->int= "(int)RemoveDirectory($1.c_str())" requires Win32_headers::windows_h;
fun getcwd():string =
{
var b: array[char,1024];
var p = getcwd((&b).stl_begin,size 1024);
return if C_hack::isNULL p then "" else string p endif;
}
fun mk_absolute_filename(s:string) =>
if Win32Filename::is_absolute_filename s then s else
#getcwd + "\\" + s
;
fun filesin(dname:string): opt[list[string]] =
{
var d : DIR_t ;
var fileinfo : FINDDATA_t ;
var files = Empty[string];
findfirst (dname+"\\*", &fileinfo, &d) ;
if findfailed d do
if errno == ENOENT or errno == EINVAL do
return None[list[string]] ;
done
eprintln$ "findfirst() failed unexpectedly" ;
assert false ;
done
var stat : int ;
harvestnext:>
var f : string = filename fileinfo ;
if f != ".." and f != "." do
files += filename fileinfo ;
done
findnext(d, &fileinfo, &stat) ;
if stat == 0 goto harvestnext ;
if stat == -1 do
if errno == ENOENT goto harvestexit ;
assert false ;
else
println "Error reading dir"; fflush;
findclose d ;
return None[list[string]] ;
done
harvestexit:>
findclose d ;
return Some files ;
}
}
}