[m-rev.] Updated posix patch

Michael Day mikeday at corplink.com.au
Sat Jul 14 21:04:28 AEST 2001


Hi,

This patch now includes wrappers for:

	- opendir, closedir, readdir
	- fork, wait, exec
	- dup
	- mkdir, rmdir
	- stat

It probably needs some review (It Works For Me) and a kindly soul to place
it in cvs.

Thanks,

Michael
-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__closedir.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__closedir.

:- interface.

:- import_module io.

:- pred closedir(dir, io__state, io__state).
:- mode closedir(in, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- pragma c_header_code("
#include <sys/types.h>
#include <dirent.h>
").

:- pragma c_code(closedir(Dir::in, IO0::di, IO::uo),
	[will_not_call_mercury, thread_safe], "
	closedir((DIR *)Dir);
	IO = IO0;
").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__fork.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__fork.

:- interface.

:- type whoami
	--->	child
	;	parent(pid)
	.

:- pred fork(posix__result(whoami), io__state, io__state).
:- mode fork(out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module int.

:- pragma c_header_code("
	#include <sys/types.h>
	#include <unistd.h>
").

%------------------------------------------------------------------------------%

fork(Result) -->
	fork0(Pid),
	( if { Pid < 0 } then
		errno(Err),
		{ Result = error(Err) }
	else if { Pid = 0 } then
		{ Result = ok(child) }
	else
		{ Result = ok(parent(pid(Pid))) }
	).

:- pred fork0(int, io__state, io__state).
:- mode fork0(out, di, uo) is det.

:- pragma c_code(fork0(Pid::out, IO0::di, IO::uo), [will_not_call_mercury], "{
	Pid = fork();
	IO = IO0;
}").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__opendir.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__opendir.

:- interface.

:- import_module io, string.

:- pred opendir(string, posix__result(dir), io__state, io__state).
:- mode opendir(in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- pragma c_header_code("
#include <sys/types.h>
#include <dirent.h>
").

opendir(Path, Result) -->
	opendir0(Path, Dir, Res),
	( if { Res = 0 } then
		{ Result = ok(Dir) }
	else
		errno(Err),
		{ Result = error(Err) }
	).				    

:- pred opendir0(string, dir, int, io__state, io__state).
:- mode opendir0(in, out, out, di, uo) is det.

:- pragma c_code(opendir0(Path::in, Dir::out, Res::out, IO0::di, IO::uo),
		[will_not_call_mercury, thread_safe], "
	Dir = (MR_Word) opendir(Path);
	Res = Dir == 0;
	IO = IO0;
").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 2001 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__stat.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__stat.

:- interface.

:- import_module int, string.

:- type file_type
    --->    file
    ;	    directory
    ;	    symbolic_link
    ;	    character_device
    ;	    block_device
    ;	    fifo
    ;	    unknown
    .

:- type stat.

:- func device(stat) = int.
:- func inode(stat) = int.
:- func mode(stat) = (mode).
:- func file_type(stat) = file_type.
:- func nlink(stat) = int.
:- func uid(stat) = int.
:- func gid(stat) = int.
:- func rdev(stat) = int.
:- func size(stat) = int.
:- func blksize(stat) = int.
:- func blocks(stat) = int.
:- func atime(stat) = int.
:- func mtime(stat) = int.
:- func ctime(stat) = int.

:- pred stat(string, posix__result(stat), io__state, io__state).
:- mode stat(in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- pragma c_header_code("
	#include <sys/types.h>
	#include <sys/stat.h>
	#include <unistd.h>
").

%------------------------------------------------------------------------------%

:- type stat ---> stat(c_pointer).

stat(Path, Result) -->
	stat0(Path, Res, Stat),
	( if { Res = 0 } then
		{ Result = ok(Stat) }
	else
		errno(Err),
		{ Result = error(Err) }
	).				    

:- pred stat0(string, int, stat, io__state, io__state).
:- mode stat0(in, out, out, di, uo) is det.

:- pragma c_code(stat0(Path::in, Res::out, Stat::out, IO0::di, IO::uo),
		[will_not_call_mercury, thread_safe], "{
	Stat = (MR_Word) GC_NEW(struct stat);
	Res = stat(Path, (struct stat *)Stat);
	IO = IO0;
}").

file_type(Stat) =
	( if is_slnk(Mode) then symbolic_link
	else if is_reg(Mode) then file
	else if is_dir(Mode) then directory
	else if is_chr(Mode) then character_device
	else if is_blk(Mode) then block_device
	else if is_fifo(Mode) then fifo
	else unknown ) :- Mode = Stat ^ (mode).

:- pred is_slnk(mode).
:- mode is_slnk(in) is semidet.

:- pragma c_code(is_slnk(Mode::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = S_ISLNK(Mode); ").

:- pred is_reg(mode).
:- mode is_reg(in) is semidet.

:- pragma c_code(is_reg(Mode::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = S_ISREG(Mode); ").

:- pred is_dir(mode).
:- mode is_dir(in) is semidet.

:- pragma c_code(is_dir(Mode::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = S_ISDIR(Mode); ").

:- pred is_chr(mode).
:- mode is_chr(in) is semidet.

:- pragma c_code(is_chr(Mode::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = S_ISCHR(Mode); ").

:- pred is_blk(mode).
:- mode is_blk(in) is semidet.

:- pragma c_code(is_blk(Mode::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = S_ISBLK(Mode); ").

:- pred is_fifo(mode).
:- mode is_fifo(in) is semidet.

:- pragma c_code(is_fifo(Mode::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = S_ISFIFO(Mode); ").

:- pragma c_code(device(S::in) = (Dev::out),
	[will_not_call_mercury, thread_safe],
	"Dev = ((struct stat *)S)->st_dev; ").

:- pragma c_code(inode(S::in) = (Ino::out),
	[will_not_call_mercury, thread_safe],
	"Ino = ((struct stat *)S)->st_ino; ").

:- pragma c_code(mode(S::in) = (Mode::out),
	[will_not_call_mercury, thread_safe],
	"Mode = ((struct stat *)S)->st_mode; ").

:- pragma c_code(nlink(S::in) = (Nlink::out),
	[will_not_call_mercury, thread_safe],
	"Nlink = ((struct stat *)S)->st_nlink; ").

:- pragma c_code(uid(S::in) = (Uid::out),
	[will_not_call_mercury, thread_safe],
	"Uid = ((struct stat *)S)->st_uid; ").

:- pragma c_code(gid(S::in) = (Gid::out),
	[will_not_call_mercury, thread_safe],
	"Gid = ((struct stat *)S)->st_gid; ").

:- pragma c_code(rdev(S::in) = (Rdev::out),
	[will_not_call_mercury, thread_safe],
	"Rdev = ((struct stat *)S)->st_rdev; ").

:- pragma c_code(size(S::in) = (Size::out),
	[will_not_call_mercury, thread_safe],
	"Size = ((struct stat *)S)->st_size; ").

:- pragma c_code(blksize(S::in) = (Blksize::out),
	[will_not_call_mercury, thread_safe],
	"Blksize = ((struct stat *)S)->st_blksize; ").

:- pragma c_code(blocks(S::in) = (Blocks::out),
	[will_not_call_mercury, thread_safe],
	"Blocks = ((struct stat *)S)->st_blocks; ").

:- pragma c_code(atime(S::in) = (Atime::out),
	[will_not_call_mercury, thread_safe],
	"Atime = ((struct stat *)S)->st_atime; ").

:- pragma c_code(mtime(S::in) = (Mtime::out),
	[will_not_call_mercury, thread_safe],
	"Mtime = ((struct stat*)S)->st_mtime; ").

:- pragma c_code(ctime(S::in) = (Ctime::out),
	[will_not_call_mercury, thread_safe],
	"Ctime = ((struct stat *)S)->st_ctime; ").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__dup.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__dup.

:- interface.

:- pred dup(fd, posix__result(fd), io__state, io__state).
:- mode dup(in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module int.

:- pragma c_header_code("
	#include <unistd.h>
").

%------------------------------------------------------------------------------%

dup(Fd, Result) -->
	dup0(Fd, fd(NewFd)),
	( if { NewFd < 0 } then
		errno(Err),
		{ Result = error(Err) }
	else
		{ Result = ok(fd(NewFd)) }
	).

:- pred dup0(fd, fd, io__state, io__state).
:- mode dup0(in, out, di, uo) is det.

:- pragma c_code(dup0(OldFd::in, NewFd::out, IO0::di, IO::uo),
		[will_not_call_mercury, thread_safe], "{
	NewFd = dup(OldFd);
	IO = IO0;
}").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix.m
% main author: conway at cs.mu.oz.au
%
% This module (with its submodules) provides a bare interface to the POSIX.3
% operating system interface. It is intended for providing basic functionality
% to other library functionality (such as a user oriented IO facility).
%
% Conventions
% -----------
%
% File descriptors and other `descriptor' like entities are represented by
% distinct types using a single-constructor, single-argument wrapper, which
% is mandated by Mercury to have the same representation as the argument
% (these are sometimes refered to as `notag' types). In most cases these
% are concrete rather than abstract, because the intent for this POSIX
% binding is to provide flexible glue to the C functionality, rather than
% to provide abstractions of the functionality.
%
% Flags are represented by enumerations. Since Mercury doesn't [yet] allow 
% for user assignable values for enumerations, these are mapped onto ints,
% and the ints are used to index static C arrays of the flag constants.
%
%------------------------------------------------------------------------------%
:- module posix.

:- interface.

:- import_module io.

:- include_module posix__closedir.
:- include_module posix__dup.
:- include_module posix__exec.
:- include_module posix__fork.
:- include_module posix__lseek.
:- include_module posix__mkdir.
:- include_module posix__open.
:- include_module posix__opendir.
:- include_module posix__read.
:- include_module posix__readdir.
:- include_module posix__rmdir.
:- include_module posix__select.
:- include_module posix__socket.
:- include_module posix__stat.
:- include_module posix__wait.
:- include_module posix__write.

	% Generic file descriptors.
:- type fd --->	fd(int).

	% Directory streams.
:- type dir ---> dir(c_pointer).

	% Process identifiers.
:- type pid ---> pid(int).

:- type error
	--->	e2BIG			/* Arg list too long */
	;	eACCES			/* Permission denied */
	;	eAGAIN			/* Try again */
	;	eBADF			/* Bad file number */
	;	eBADMSG			/* Not a data message */
	;	eBUSY			/* Device or resource busy */
	%;	eCANCELED		/* Operation canceled */
	;	eCHILD			/* No child processes */
	;	eDEADLK			/* Resource deadlock would occur */
	;	eDOM			/* Math argument out of domain */
	;	eEXIST			/* File exists */
	;	eFAULT			/* Bad address */
	;	eFBIG			/* File too large */
	;	eINPROGRESS		/* Operation now in progress */
	;	eINTR			/* Interrupted system call */
	;	eINVAL			/* Invalid argument */
	;	eIO			/* I/O error */
	;	eISDIR			/* Is a directory */
	;	eMFILE			/* Too many open files */
	;	eMLINK			/* Too many links */
	;	eMSGSIZE		/* Message too long */
	;	eNAMETOOLONG		/* File name too long */
	;	eNFILE			/* File table overflow */
	;	eNODEV			/* No such device */
	;	eNOENT			/* No such file or directory */
	;	eNOEXEC			/* Exec format error */
	%;	eNOLOCK			/* No locks available */
	;	eNOMEM			/* Out of memory */
	;	eNOSPC			/* No space left on device */
	;	eNOSYS			/* Function not implemented */
	;	eNOTDIR			/* Not a directory */
	;	eNOTEMPTY		/* Directory not empty */
	%;	eNOTSUP			/* Not supported */
	;	eNOTTY			/* Not a typewriter */
	;	eNXIO			/* No such device or address */
	;	ePERM			/* Operation not permitted */
	;	ePIPE			/* Broken pipe */
	;	eRANGE			/* Math result not representable */
	;	eROFS			/* Read-only file system */
	;	eSPIPE			/* Illegal seek */
	;	eSRCH			/* No such process */
	;	eTIMEDOUT		/* Connection timed out */
	;	eXDEV			/* Cross-device link */
	;	unknown(int, string)	% unknown(Errno, Msg)
	.

:- type posix__result
	--->	ok
	;	error(posix__error)
	.

:- type posix__result(T)
	--->	ok(T)
	;	error(posix__error)
	.

:- type (mode)	--->	mode(int).

:- type timeval
	--->	timeval(int, int). % time(Sec, uSec)

:- pred errno(posix__error, io__state, io__state).
:- mode errno(out, di, uo) is det.

:- implementation.

:- import_module require.

:- pragma c_header_code("
	#include <unistd.h>
	#include <errno.h>
").

errno(Error) -->
	errno0(ErrNo),
	{ Error = error(errnumber(ErrNo)) }.

:- pred errno0(int, io__state, io__state).
:- mode errno0(out, di, uo) is det.

:- pragma c_code(errno0(E::out, IO0::di, IO::uo),
		[will_not_call_mercury, thread_safe], "{
	E = errno;
	IO = IO0;
}").

:- func error(int) = posix__error.

error(Num) = Res :-
	((	Num = 0,	Err = e2BIG
	;	Num = 1,	Err = eACCES
	;	Num = 2,	Err = eAGAIN
	;	Num = 3,	Err = eBADF
	;	Num = 4,	Err = eBADMSG
	;	Num = 5,	Err = eBUSY
	%;	Num = 6,	Err = eCANCELED
	;	Num = 7,	Err = eCHILD
	;	Num = 8,	Err = eDEADLK
	;	Num = 9,	Err = eDOM
	;	Num = 10,	Err = eEXIST
	;	Num = 11,	Err = eFAULT
	;	Num = 12,	Err = eFBIG
	;	Num = 13,	Err = eINPROGRESS
	;	Num = 14,	Err = eINTR
	;	Num = 15,	Err = eINVAL
	;	Num = 16,	Err = eIO
	;	Num = 17,	Err = eISDIR
	;	Num = 18,	Err = eMFILE
	;	Num = 19,	Err = eMLINK
	;	Num = 20,	Err = eMSGSIZE
	;	Num = 21,	Err = eNAMETOOLONG
	;	Num = 22,	Err = eNFILE
	;	Num = 23,	Err = eNODEV
	;	Num = 24,	Err = eNOENT
	;	Num = 25,	Err = eNOEXEC
	%;	Num = 26,	Err = eNOLOCK
	;	Num = 27,	Err = eNOMEM
	;	Num = 28,	Err = eNOSPC
	;	Num = 29,	Err = eNOSYS
	;	Num = 30,	Err = eNOTDIR
	;	Num = 31,	Err = eNOTEMPTY
	%;	Num = 32,	Err = eNOTSUP
	;	Num = 33,	Err = eNOTTY
	;	Num = 34,	Err = eNXIO
	;	Num = 35,	Err = ePERM
	;	Num = 36,	Err = ePIPE
	;	Num = 37,	Err = eRANGE
	;	Num = 38,	Err = eROFS
	;	Num = 39,	Err = eSPIPE
	;	Num = 40,	Err = eSRCH
	;	Num = 41,	Err = eTIMEDOUT
	;	Num = 42,	Err = eXDEV
	) ->
		Res = Err
	;
		Res = unknown(Num, "unknown errno")
	).

:- func errnumber(int) = int.
:- mode (errnumber(in) = out) is det.

:- pragma c_code(errnumber(Er::in) = (En::out),
		[will_not_call_mercury, thread_safe], "{
	switch (Er) {
		case E2BIG:	En = 0;		break;
		case EACCES:	En = 1;		break;
		case EAGAIN:	En = 2;		break;
		case EBADF:	En = 3;		break;
		case EBADMSG:	En = 4;		break;
		case EBUSY:	En = 5;		break;
		/* case ECANCELED:	En = 6;		break; */
		case ECHILD:	En = 7;		break;
		case EDEADLK:	En = 8;		break;
		case EDOM:	En = 9;		break;
		case EEXIST:	En = 10;	break;
		case EFAULT:	En = 11;	break;
		case EFBIG:	En = 12;	break;
		case EINPROGRESS: En = 13;	break;
		case EINTR:	En = 14;	break;
		case EINVAL:	En = 15;	break;
		case EIO:	En = 16;	break;
		case EISDIR:	En = 17;	break;
		case EMFILE:	En = 18;	break;
		case EMLINK:	En = 19;	break;
		case EMSGSIZE:	En = 20;	break;
		case ENAMETOOLONG: En = 21;	break;
		case ENFILE:	En = 22;	break;
		case ENODEV:	En = 23;	break;
		case ENOENT:	En = 24;	break;
		case ENOEXEC:	En = 25;	break;
		/* case ENOLOCK:	En = 26;	break; */
		case ENOMEM:	En = 27;	break;
		case ENOSPC:	En = 28;	break;
		case ENOSYS:	En = 29;	break;
		case ENOTDIR:	En = 30;	break;
		case ENOTEMPTY:	En = 31;	break;
		/* case ENOTSUP:	En = 32;	break; */
		case ENOTTY:	En = 33;	break;
		case ENXIO:	En = 34;	break;
		case EPERM:	En = 35;	break;
		case EPIPE:	En = 36;	break;
		case ERANGE:	En = 37;	break;
		case EROFS:	En = 38;	break;
		case ESPIPE:	En = 39;	break;
		case ESRCH:	En = 40;	break;
		case ETIMEDOUT:	En = 41;	break;
		case EXDEV:	En = 42;	break;
		default:
			En = -1;
	}
}").

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__readdir.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__readdir.

:- interface.

:- import_module io, string.

:- pred readdir(dir, posix__result(string), io__state, io__state).
:- mode readdir(in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- pragma c_header_code("
#include <sys/types.h>
#include <dirent.h>
").

readdir(Dir, Result) -->
	readdir0(Dir, Entry, Res),
	( if { Res = 0 } then
		{ Result = ok(Entry) }
	else
		errno(Err),
		{ Result = error(Err) }
	).				    

:- pred readdir0(dir, string, int, io__state, io__state).
:- mode readdir0(in, out, out, di, uo) is det.

:- pragma c_code(readdir0(Dir::in, Entry::out, Result::out, IO0::di, IO::uo),
		[will_not_call_mercury, thread_safe], "
	struct dirent *ent = readdir((DIR *)Dir);
	if (ent != NULL) {
		MR_save_transient_hp();
		MR_make_aligned_string_copy(Entry, ent->d_name);
		MR_restore_transient_hp();
		Result = 0;
	} else {
		Entry = NULL;
		Result = 1;
	}
	IO = IO0;
").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__wait.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__wait.

:- interface.

:- type status
	--->	exit(int)
	;	signal(int)
	.

:- pred wait(posix__result({pid, status}), io__state, io__state).
:- mode wait(out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module int.

:- pragma c_header_code("
	#include <sys/types.h>
	#include <sys/wait.h>
").

%------------------------------------------------------------------------------%

wait(Result) -->
	wait0(Pid, Status),
	( if { Pid < 0 } then
		errno(Err),
		{ Result = error(Err) }
	else
		{ if if_exited(Status) then
			Result = ok({pid(Pid), exit(exit_status(Status))})
		else
			Result = ok({pid(Pid), signal(term_sig(Status))})
		}
	).

:- pred wait0(int, int, io__state, io__state).
:- mode wait0(out, out, di, uo) is det.

:- pragma c_code(wait0(Pid::out, Status::out, IO0::di, IO::uo),
		[will_not_call_mercury, thread_safe], "{
	int status;
	Pid = wait(&status);
	Status = status;
	IO = IO0;
}").

:- pred if_exited(int).
:- mode if_exited(in) is semidet.

:- pragma c_code(if_exited(Status::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = WIFEXITED(Status);
").

:- pred if_signaled(int).
:- mode if_signaled(in) is semidet.

:- pragma c_code(if_signaled(Status::in), [will_not_call_mercury, thread_safe], "
	SUCCESS_INDICATOR = WIFSIGNALED(Status);
").

:- func exit_status(int) = int.

:- pragma c_code(exit_status(Status::in) = (ExitCode::out),
		[will_not_call_mercury, thread_safe],
"
	ExitCode = WEXITSTATUS(Status);
").

:- func term_sig(int) = int.

:- pragma c_code(term_sig(Status::in) = (ExitCode::out),
		[will_not_call_mercury, thread_safe],
"
	ExitCode = WTERMSIG(Status);
").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__exec.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__exec.

:- interface.

:- import_module string, list, map.

:- type argv == list(string).

:- type env == map(string, string).

:- pred exec(string, argv, env, posix__result, io__state, io__state).
:- mode exec(in, in, in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module array, std_util.

:- pragma c_header_code("
	#include <unistd.h>
").

%------------------------------------------------------------------------------%

exec(Command, Args, Env, Result) -->
	exec0(Command,
	    array(Args ++ [null]),
	    array(map(variable, to_assoc_list(Env)) ++ [null])
	),
	errno(Err),
	{ Result = error(Err) }.

:- func variable(pair(string)) = string.

variable(Name - Value) = Name ++ "=" ++ Value.

:- func null = string.

:- pragma c_code(null = (Null::out), [will_not_call_mercury, thread_safe],
    "Null = NULL; ").

:- pred exec0(string, array(string), array(string), io__state, io__state).
:- mode exec0(in, array_ui, array_ui, di, uo) is det.

:- pragma c_code(exec0(Command::in, Args::array_ui, Env::array_ui,
		IO0::di, IO::uo), [will_not_call_mercury], "{
	execve(Command,
	    ((MR_ArrayType *)Args)->elements, 
	    ((MR_ArrayType *)Env)->elements);
	IO = IO0;
}").

%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 2001 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__mkdir.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__mkdir.

:- interface.

:- import_module string.

:- pred mkdir(string, mode, posix__result, io__state, io__state).
:- mode mkdir(in, in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module int.

:- pragma c_header_code("
	#include <sys/types.h>
	#include <sys/stat.h>
").

%------------------------------------------------------------------------------%

mkdir(Path, Mode, Result) -->
	mkdir0(Path, Mode, Res),
	( if { Res = 0 } then
	    { Result = ok }
	else
	    errno(Err),
	    { Result = error(Err) }
	).				    

:- pred mkdir0(string, mode, int, io__state, io__state).
:- mode mkdir0(in, in, out, di, uo) is det.

:- pragma c_code(mkdir0(Path::in, Mode::in, Res::out, IO0::di, IO::uo),
	    [will_not_call_mercury, thread_safe], "
	Res = mkdir(Path, Mode);
	IO = IO0;
").
		
%------------------------------------------------------------------------------%

-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 2001 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: posix__rmdir.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__rmdir.

:- interface.

:- import_module string.

:- pred rmdir(string, posix__result, io__state, io__state).
:- mode rmdir(in, out, di, uo) is det.

%------------------------------------------------------------------------------%

:- implementation.

:- import_module int.

:- pragma c_header_code("
	#include <unistd.h>
").

%------------------------------------------------------------------------------%

rmdir(Path, Result) -->
	rmdir0(Path, Res),
	( if { Res = 0 } then
	    { Result = ok }
	else
	    errno(Err),
	    { Result = error(Err) }
	).				    

:- pred rmdir0(string, int, io__state, io__state).
:- mode rmdir0(in, out, di, uo) is det.

:- pragma c_code(rmdir0(Path::in, Res::out, IO0::di, IO::uo),
	    [will_not_call_mercury, thread_safe], "
	Res = rmdir(Path);
	IO = IO0;
").
		
%------------------------------------------------------------------------------%



More information about the reviews mailing list