[m-rev.] diff: start using new FLI in posix binding

Julien Fischer juliensf at csse.unimelb.edu.au
Mon Apr 23 14:32:05 AEST 2007


Estimated hours taken: 1
Branches: main

Begin moving the posix binding over to the new foreign language interface

Conform to our current coding standard in (some of) the posix binding.

extras/posix/posix.closedir.m:
extras/posix/posix.dup.m:
extras/posix/posix.fork.m:
extras/posix/posix.getpid.m:
extras/posix/posix.m:
extras/posix/posix.opendir.m:
 	Use the new foreign language interface in these modules.

 	Use predmode declarations where appropriate.

 	Use 4-space indentation throughout.

 	Define the type posix.dir/0 as a foreign type.

Julien.

Index: posix.closedir.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/posix/posix.closedir.m,v
retrieving revision 1.1
diff -u -r1.1 posix.closedir.m
--- posix.closedir.m	16 Jul 2001 03:08:18 -0000	1.1
+++ posix.closedir.m	23 Apr 2007 04:30:06 -0000
@@ -1,36 +1,41 @@
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % 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__closedir.m
-% main author: Michael Day <miked at lendtech.com.au>
+% Module: posix.closedir.m.
+% Main author: Michael Day <miked at lendtech.com.au>
  %
-%------------------------------------------------------------------------------%
-:- module posix__closedir.
+%-----------------------------------------------------------------------------%

+:- module posix.closedir.
  :- interface.

  :- import_module io.

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

-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

  :- implementation.

-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
  #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;
+:- pragma foreign_proc("C",
+    closedir(Dir::in, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    closedir(Dir);
+    IO = IO0;
  ").

-%------------------------------------------------------------------------------%
-
+%-----------------------------------------------------------------------------%
+:- end_module posix.closedir.
+%-----------------------------------------------------------------------------%
Index: posix.dup.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/posix/posix.dup.m,v
retrieving revision 1.2
diff -u -r1.2 posix.dup.m
--- posix.dup.m	5 Dec 2006 03:45:08 -0000	1.2
+++ posix.dup.m	23 Apr 2007 04:30:06 -0000
@@ -1,72 +1,75 @@
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % Copyright (C) 2001, 2006 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.m
+% Main author: Michael Day <miked at lendtech.com.au>
  %
-%------------------------------------------------------------------------------%
-:- module posix__dup.
+%-----------------------------------------------------------------------------%

+:- module posix.dup.
  :- interface.

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

-:- pred dup2(fd, fd, posix__result(fd), io__state, io__state).
-:- mode dup2(in, in, out, di, uo) is det.
+:- pred dup2(fd::in, fd::in, posix.result(fd)::out, io::di, io::uo) is det.

-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

  :- implementation.

  :- import_module int.

-:- pragma c_header_code("
-	#include <unistd.h>
+:- pragma foreign_decl("C", "
+    #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;
-}").
-
-%------------------------------------------------------------------------------%
+dup(Fd, Result, !IO) :-
+    dup0(Fd, fd(NewFd), !IO),
+    ( if NewFd < 0  then
+        errno(Err, !IO),
+        Result = error(Err)
+    else
+        Result = ok(fd(NewFd))
+    ).
+
+:- pred dup0(fd::in, fd::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    dup0(OldFd::in, NewFd::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    NewFd = dup(OldFd);
+    IO = IO0;
+").

-dup2(OldFd, NewFd, Result) -->
-	dup2_2(OldFd, NewFd, fd(Ret)),
-	( if { Ret < 0 } then
-		errno(Err),
-		{ Result = error(Err) }
-	else
-		{ Result = ok(fd(Ret)) }
-	).
-
-:- pred dup2_2(fd, fd, fd, io__state, io__state).
-:- mode dup2_2(in, in, out, di, uo) is det.
-
-:- pragma c_code(dup2_2(OldFd::in, NewFd::in, Ret::out, IO0::di, IO::uo),
-		[will_not_call_mercury, thread_safe], "{
-	Ret = dup2(OldFd, NewFd);
-	IO = IO0;
-}").
+%-----------------------------------------------------------------------------%

-%------------------------------------------------------------------------------%
+dup2(OldFd, NewFd, Result, !IO) :-
+    dup2_2(OldFd, NewFd, fd(Ret), !IO),
+    ( if Ret < 0 then
+        errno(Err, !IO),
+        Result = error(Err)
+    else
+        Result = ok(fd(Ret))
+    ).
+
+:- pred dup2_2(fd::in, fd::in, fd::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    dup2_2(OldFd::in, NewFd::in, Ret::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    Ret = dup2(OldFd, NewFd);
+    IO = IO0;
+").

+%-----------------------------------------------------------------------------%
+:- end_module posix.dup.
+%-----------------------------------------------------------------------------%
Index: posix.fork.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/posix/posix.fork.m,v
retrieving revision 1.2
diff -u -r1.2 posix.fork.m
--- posix.fork.m	25 Jul 2001 08:37:23 -0000	1.2
+++ posix.fork.m	23 Apr 2007 04:30:06 -0000
@@ -1,56 +1,59 @@
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % 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__fork.m
-% main author: Michael Day <miked at lendtech.com.au>
+% Module: posix.fork.m
+% Main author: Michael Day <miked at lendtech.com.au>
  %
-%------------------------------------------------------------------------------%
-:- module posix__fork.
+%-----------------------------------------------------------------------------%

+:- module posix.fork.
  :- interface.

  :- type whoami
-	--->	child
-	;	parent(pid_t)
-	.
+    --->    child
+    ;       parent(pid_t).

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

-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

  :- implementation.

  :- import_module int.

-:- pragma c_header_code("
-	#include <sys/types.h>
-	#include <unistd.h>
+:- pragma foreign_decl("C", "
+    #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;
-}").
+fork(Result, !IO) :-
+    fork0(Pid, !IO),
+    ( if Pid < 0 then
+        errno(Err, !IO),
+        Result = error(Err)
+    else if Pid = 0 then
+        Result = ok(child)
+    else
+        Result = ok(parent(pid(Pid)))
+    ).
+
+:- pred fork0(int::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    fork0(Pid::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+    Pid = fork();
+    IO = IO0;
+").

  %------------------------------------------------------------------------------%
-
+:- end_module posix.fork.
+%------------------------------------------------------------------------------%
Index: posix.getpid.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/posix/posix.getpid.m,v
retrieving revision 1.1
diff -u -r1.1 posix.getpid.m
--- posix.getpid.m	24 Aug 2001 03:02:36 -0000	1.1
+++ posix.getpid.m	23 Apr 2007 04:30:06 -0000
@@ -1,47 +1,53 @@
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % 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__getpid.m
-% main author: Michael Day <miked at lendtech.com.au>
+% Module: posix.getpid.m
+% Main author: Michael Day <miked at lendtech.com.au>
  %
-%------------------------------------------------------------------------------%
-:- module posix__getpid.
+%-----------------------------------------------------------------------------%

+:- module posix.getpid.
  :- interface.

-:- pred getpid(pid_t, io__state, io__state).
-:- mode getpid(out, di, uo) is det.
+:- pred getpid(pid_t::out, io::di, io::uo) is det.

-:- pred getppid(pid_t, io__state, io__state).
-:- mode getppid(out, di, uo) is det.
+:- pred getppid(pid_t::out, io::di, io::uo) is det.

-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

  :- implementation.

  :- import_module int.

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

-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

-:- pragma c_code(getpid(Pid::out, IO0::di, IO::uo),
-		[will_not_call_mercury, thread_safe], "
-	Pid = getpid();
-	IO = IO0;
+:- pragma foreign_proc("C",
+    getpid(Pid::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    Pid = getpid();
+    IO = IO0;
  ").

-:- pragma c_code(getppid(Pid::out, IO0::di, IO::uo),
-		[will_not_call_mercury, thread_safe], "
-	Pid = getppid();
-	IO = IO0;
+:- pragma foreign_proc("C",
+    getppid(Pid::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    Pid = getppid();
+    IO = IO0;
  ").

-%------------------------------------------------------------------------------%
-
+%-----------------------------------------------------------------------------%
+:- end_module posix.getpid.
+%-----------------------------------------------------------------------------%
Index: posix.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/posix/posix.m,v
retrieving revision 1.6
diff -u -r1.6 posix.m
--- posix.m	7 Sep 2001 01:20:42 -0000	1.6
+++ posix.m	23 Apr 2007 04:30:06 -0000
@@ -1,11 +1,13 @@
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % Copyright (C) 1999, 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.m
-% main author: conway at cs.mu.oz.au
+% 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
@@ -17,7 +19,7 @@
  % 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
+% (these are sometimes referred 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.
@@ -26,259 +28,284 @@
  % 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.
+%-----------------------------------------------------------------------------%

+:- module posix.
  :- interface.

-:- import_module io, int, integer.
-
-:- include_module posix__closedir.
-:- include_module posix__dup.
-:- include_module posix__exec.
-:- include_module posix__fork.
-:- include_module posix__getpid.
-:- include_module posix__kill.
-:- include_module posix__lseek.
-:- include_module posix__mkdir.
-:- include_module posix__open.
-:- include_module posix__opendir.
-:- include_module posix__pipe.
-:- 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).
+:- import_module int.
+:- import_module integer.
+:- import_module io.
+
+:- include_module posix.closedir.
+:- include_module posix.dup.
+:- include_module posix.exec.
+:- include_module posix.fork.
+:- include_module posix.getpid.
+:- include_module posix.kill.
+:- include_module posix.lseek.
+:- include_module posix.mkdir.
+:- include_module posix.open.
+:- include_module posix.opendir.
+:- include_module posix.pipe.
+:- 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.
+    % Directory streams.
+    %
  :- type dir ---> dir(c_pointer).

-	% Devices.
+    % Devices.
+    %
  :- type dev_t ---> dev(int).

-	% File modes.
+    % File modes.
+    %
  :- type mode_t ---> mode(int).

-	% Inodes.
+    % Inodes.
+    %
  :- type ino_t ---> ino(int).

-	% Link counts.
+    % Link counts.
+    %
  :- type nlink_t ---> nlink(int).

-	% File offsets.
+    % File offsets.
+    %
  :- type off_t ---> off(integer).

-	% Block counts.
+    % Block counts.
+    %
  :- type blkcnt_t ---> blkcnt(integer).

-	% Block size.
+    % Block size.
+    %
  :- type blksize_t ---> blksize(int).

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

-	% User identifiers.
+    % User identifiers.
+    %
  :- type uid_t ---> uid(int).

-	% Group identifiers.
+    % Group identifiers.
+    %
  :- type gid_t ---> gid(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_t. % XXX This is deprecated; please use mode_t.
+    --->    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 timeval
-	--->	timeval(int, int). % time(Sec, uSec)
+    --->    timeval(int, int). % time(Sec, uSec)
+
+:- pred errno(posix.error::out, io::di, io::uo) is det.

-:- 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>
+:- pragma foreign_decl("C", "
+    #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;
-}").
+%-----------------------------------------------------------------------------%
+
+:- interface.

-:- func error(int) = posix__error.
+:- pragma foreign_type("C", dir, "DIR *", [can_pass_as_mercury_type]).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+errno(Error, !IO) :-
+    errno0(ErrNo, !IO),
+    Error = error(errnumber(ErrNo)).
+
+:- pred errno0(int::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    errno0(E::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    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")
-	).
+    ((  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;
-	}
-}").
+:- pragma foreign_proc("C",
+    errnumber(Er::in) = (En::out),
+    [promise_pure, 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;
+    }
+").

Index: posix.opendir.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/posix/posix.opendir.m,v
retrieving revision 1.1
diff -u -r1.1 posix.opendir.m
--- posix.opendir.m	16 Jul 2001 03:08:18 -0000	1.1
+++ posix.opendir.m	23 Apr 2007 04:30:06 -0000
@@ -1,49 +1,53 @@
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % 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__opendir.m
-% main author: Michael Day <miked at lendtech.com.au>
+% Module: posix.opendir.m
+% Main author: Michael Day <miked at lendtech.com.au>
  %
-%------------------------------------------------------------------------------%
-:- module posix__opendir.
+%-----------------------------------------------------------------------------%

+:- module posix.opendir.
  :- interface.

-:- import_module io, string.
+:- import_module io.
+:- import_module string.

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

-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

  :- implementation.

-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
  #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;
+opendir(Path, Result, !IO) :-
+    opendir0(Path, Dir, Res, !IO),
+    ( if Res = 0 then
+        Result = ok(Dir)
+    else
+        errno(Err, !IO),
+        Result = error(Err)
+    ). 
+
+:- pred opendir0(string::in, dir::out, int::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    opendir0(Path::in, Dir::out, Res::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    Dir = opendir(Path);
+    Res = (Dir == NULL);
+    IO = IO0;
  ").

-%------------------------------------------------------------------------------%
-
+%-----------------------------------------------------------------------------%
+:- end_module posix.opendir.
+%-----------------------------------------------------------------------------%

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list