[m-dev.] for review: add `time' module to standard library

[Fergus Henderson]

Estimated hours taken: 3
	(plus unknown time by Thomas By)

library/time.m:
	New module, originally written by Thomas By <T.By at dcs.shef.ac.uk>.
	This provides an interface to the ANSI/ISO C time functions.
	I have made the following changes to Thomas By's version:
	    * bug fixes:
		- fixed a bug where it had `will_not_call_mercury'
		  instead of `may_call_mercury' in a couple of places;
		  the fix was to change the code to use
		  MR_make_aligned_string_copy() rather than
		  calling builtin__copy/2 via `pragma export'.
		- fixed a bug where it was casting an `Integer *'
		  to a `time_t *'; that won't have the desired effect
		  if `Integer' and `time_t' are not the same size.
	    * interface changes:
	        - changed the clocks_per_second procedure so that
		  it did not take any io__state arguments
		  (that's safe, since ANSI/ISO C requires the
		  CLOCKS_PER_SECOND macro to be a constant expression)
		- changed the DST field from `maybe(bool)' to `maybe(dst)',
		  where `dst' is an enumeration type defined as
		  `:- type dst ---> standard_time ; daylight_time'.
		- changed all the predicates with only one output
		  into functions
		- changed the code to throw exceptions on failure rather
		  than returning results of type `io__res(T)'
	    * stylistic changes:
		- modified the layout to match our standard
		  Mercury coding conventions
		- added a more detailed copyright notice

library/library.m:
	Add `time' to the list of modules in the standard library.

configure.in:
runtime/mercury_conf.h.in:
	Add autoconf checks for <sys/times.h> and for the
	struct tms type and the times() function.

runtime/mercury_string.h:
runtime/mercury_bootstrap.h:
	Add `MR_' prefixes to a few macros, so that the new code
	in library/time.m doesn't need to use the old versions.
	Define the old names as aliases for the new ones
	in mercury_bootstrap.h.

NEWS:
w3/news/newsdb.inc:
	Mention the new module.

Workspace: /home/mercury0/fjh/mercury
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.150
diff -u -d -r1.150 NEWS
--- NEWS	1999/10/26 09:57:39	1.150
+++ NEWS	1999/10/27 15:30:02
@@ -73,6 +73,12 @@
   However, many of the operations in the standard library still handle
   errors by aborting execution rather than by throwing exceptions.
 
+* There's a new standard library module `time'.
+
+  The `time' module provides an interface to the ANSI/ISO C <time.h>
+  functions, and to the POSIX times() function.  Thanks to Thomas By
+  for contributing the original version of this module.
+
 * There's a new standard library module `gc', for controlling the
   garbage collector.
 
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.185
diff -u -d -r1.185 configure.in
--- configure.in	1999/10/24 08:38:54	1.185
+++ configure.in	1999/10/27 14:52:42
@@ -262,6 +262,16 @@
 	AC_DEFINE(HAVE_SYS_TIME)
 fi
 #-----------------------------------------------------------------------------#
+AC_CHECK_HEADER(sys/times.h, HAVE_SYS_TIMES_H=1)
+if test "$HAVE_SYS_TIMES_H" = 1; then
+	AC_DEFINE(HAVE_SYS_TIMES_H)
+fi
+#-----------------------------------------------------------------------------#
+AC_CHECK_HEADER(sys/types.h, HAVE_SYS_TYPES_H=1)
+if test "$HAVE_SYS_TYPES_H" = 1; then
+	AC_DEFINE(HAVE_SYS_TYPES_H)
+fi
+#-----------------------------------------------------------------------------#
 AC_CHECK_HEADER(sys/stat.h, HAVE_SYS_STAT_H=1)
 if test "$HAVE_SYS_STAT_H" = 1; then
 	AC_DEFINE(HAVE_SYS_STAT_H)
@@ -2028,6 +2038,39 @@
 AC_SUBST_FILE(INIT_GRADE_OPTIONS)
 AC_SUBST_FILE(PARSE_GRADE_OPTIONS)
 AC_SUBST_FILE(FINAL_GRADE_OPTIONS)
+
+#-----------------------------------------------------------------------------#
+#
+# Check for the POSIX struct tms and times() function.
+# This is used for the time__times procedure in library/times.m.
+#
+AC_MSG_CHECKING(for struct tms and times function)
+AC_CACHE_VAL(mercury_cv_have_posix_times,
+AC_TRY_LINK([
+	#include <sys/types.h>
+	#include <sys/times.h>
+],[
+	struct tms t;
+	long Ut, St, CUt, CSt;
+	long Ret;
+
+	Ret = (long) times(&t);
+
+	Ut = (long) t.tms_utime;
+	St = (long) t.tms_stime;
+	CUt = (long) t.tms_cutime;
+	CSt = (long) t.tms_cstime;
+],[mercury_cv_have_posix_times=yes],[mercury_cv_have_posix_times=no]))
+
+#
+# figure out whether the test succeeded
+#
+if test "$mercury_cv_have_posix_times" = yes; then
+	AC_MSG_RESULT(yes)
+	AC_DEFINE(MR_HAVE_POSIX_TIMES)
+else
+	AC_MSG_RESULT(no)
+fi
 
 #-----------------------------------------------------------------------------#
 #
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.45
diff -u -d -r1.45 library.m
--- library.m	1999/10/06 06:02:59	1.45
+++ library.m	1999/10/27 12:35:00
@@ -34,6 +34,7 @@
 :- import_module prolog.
 :- import_module integer, rational.
 :- import_module exception, gc.
+:- import_module time.
 
 % library__version must be implemented using pragma c_code,
 % so we can get at the MR_VERSION and MR_FULLARCH configuration
cvs diff: library/time.m is a new entry, no comparison available
Index: runtime/mercury_bootstrap.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_bootstrap.h,v
retrieving revision 1.11
diff -u -d -r1.11 mercury_bootstrap.h
--- mercury_bootstrap.h	1999/10/26 13:41:10	1.11
+++ mercury_bootstrap.h	1999/10/27 15:10:20
@@ -27,6 +27,11 @@
 #define	COMPARE_LESS		MR_COMPARE_LESS
 #define	COMPARE_GREATER		MR_COMPARE_GREATER
 
+#define make_aligned_string_copy(a,b)	MR_make_aligned_string_copy((a),(b))
+#define make_aligned_string(a,b)	MR_make_aligned_string((a),(b))
+#define string_equal(a,b)		MR_string_equal((a),(b))
+#define string_const(a,b)		MR_string_const((a),(b))
+
 /*
 ** The list manipulation macros are available for use by ordinary Mercury
 ** programmers. People may have written code using these macros before their
Index: runtime/mercury_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.23
diff -u -d -r1.23 mercury_conf.h.in
--- mercury_conf.h.in	1999/09/23 02:15:09	1.23
+++ mercury_conf.h.in	1999/10/27 13:08:12
@@ -101,6 +101,8 @@
 **	HAVE_SYS_PARAM		we have <sys/param.h>
 **	HAVE_SYS_WAIT		we have <sys/wait.h>
 **	HAVE_SYS_STAT_H		we have <sys/stat.h>
+**	HAVE_SYS_TYPES_H	we have <sys/types.h>
+**	HAVE_SYS_TIMES_H	we have <sys/times.h>
 **	HAVE_DLFCN_H		we have <dlfcn.h>
 */
 #undef	HAVE_SYS_SIGINFO
@@ -111,7 +113,15 @@
 #undef	HAVE_SYS_PARAM
 #undef	HAVE_SYS_WAIT
 #undef	HAVE_SYS_STAT_H
+#undef	HAVE_SYS_TIMES_H
+#undef	HAVE_SYS_TYPES_H
 #undef	HAVE_DLFCN_H
+
+/*
+** MR_HAVE_POSIX_TIMES is defined if we have the POSIX
+** `struct tms' struct and times() function.
+*/
+#undef MR_HAVE_POSIX_TIMES
 
 /*
 ** The following macros are defined iff the corresponding type
Index: runtime/mercury_string.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_string.h,v
retrieving revision 1.13
diff -u -d -r1.13 mercury_string.h
--- mercury_string.h	1999/09/27 05:20:48	1.13
+++ mercury_string.h	1999/10/27 15:09:14
@@ -36,16 +36,16 @@
 ** string_const("...", len):
 **	Given a C string literal and its length, returns a Mercury string.
 */
-#define string_const(string, len) ((String) string)
+#define MR_string_const(string, len) ((String) string)
 
 /*
 ** bool string_equal(ConstString s1, ConstString s2):
 **	Return true iff the two Mercury strings s1 and s2 are equal.
 */
-#define string_equal(s1,s2) (strcmp((char*)(s1),(char*)(s2))==0)
+#define MR_string_equal(s1,s2) (strcmp((char*)(s1),(char*)(s2))==0)
 
 /* 
-** void make_aligned_string(ConstString & ptr, const char * string):
+** void MR_make_aligned_string(ConstString & ptr, const char * string):
 **	Given a C string `string', set `ptr' to be a Mercury string
 **	with the same contents.  (`ptr' must be an lvalue.)
 **	If the resulting Mercury string is to be used by Mercury code,
@@ -61,16 +61,16 @@
 ** Otherwise, allocate space on the heap and copy the C string to
 ** the Mercury string.
 */
-#define make_aligned_string(ptr, string) 				\
+#define MR_make_aligned_string(ptr, string) 				\
 	do { 								\
 	    if (MR_tag((Word) (string)) != 0) {				\
-		make_aligned_string_copy((ptr), (string));		\
+		MR_make_aligned_string_copy((ptr), (string));		\
 	    } else { 							\
 	    	(ptr) = (string);					\
 	    }								\
 	} while(0)
 
-/* void make_aligned_string_copy(ConstString &ptr, const char * string);
+/* void MR_make_aligned_string_copy(ConstString &ptr, const char * string);
 **	Same as make_aligned_string(ptr, string), except that the string
 **	is guaranteed to be copied. This is useful for copying C strings
 **	onto the Mercury heap.
@@ -80,7 +80,7 @@
 ** rather than inside Mercury code, you may need to call
 ** save/restore_transient_hp().
 */
-#define make_aligned_string_copy(ptr, string) 				\
+#define MR_make_aligned_string_copy(ptr, string) 			\
 	do {								\
 		Word make_aligned_string_tmp;				\
 		char * make_aligned_string_ptr;				\
Index: w3/news/newsdb.inc
===================================================================
RCS file: /home/mercury1/repository/w3/news/newsdb.inc,v
retrieving revision 1.34
diff -u -d -r1.34 newsdb.inc
--- newsdb.inc	1999/09/16 04:01:33	1.34
+++ newsdb.inc	1999/10/27 15:29:17
@@ -17,6 +17,15 @@
 */
 
 $newsdb = array(
+"28 Oct 1999" => array("Time module",
+
+"The standard library now includes a module `time'
+which provides an interface to the ANSI/ISO C <time.h> functions
+and to the POSIX times() function.
+
+Thanks to Thomas By for contributing the original version of this module.
+"),
+
 "16 Sep 1999" => array("Exception handling",
 
 "Exception handling support is now part of the standard library.

===================================================================
library/time.m
===================================================================
%-----------------------------------------------------------------------------%
% Originally written in 1999 by Tomas By <T.By at dcs.shef.ac.uk>
% "Feel free to use this code or parts of it any way you want."
%
% Some portions are 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.
%-----------------------------------------------------------------------------%
%
% File: time.m.
% Main authors: Tomas By <T.By at dcs.shef.ac.uk>, fjh
% Stability: medium
%
% Time functions.
%
%-----------------------------------------------------------------------------%

:- module time.

:- interface.

:- use_module io.
:- import_module std_util.

:- type clock_t == int.

:- type tms --->
        tms(int,    % Utime
            int,    % Stime
            int,    % CUtime
            int).   % CStime

:- type time_t == int.

:- type tm --->
        tm(int,          % Seconds (0-60)
           int,          % Minutes (0-59)
           int,          % Hours (after midnight, 0-23)
           int,          % WeekDay (number since Sunday, 0-6)
           int,          % YearDay (number since Jan 1st, 0-365)
           int,          % Month (number since January, 0-11)
           int,          % Year (number since 1900)
           maybe(dst)).  % IsDST (is DST in effect?)

:- type dst
	--->	standard_time	% no, DST is not in effect
	;	daylight_time.	% yes, DST is in effect

	% Some of the procedures in this module throw this type
	% as an exception if they can't obtain a result.
:- type time_error --->
	time_error(string).	% Error message

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

	% time__clock(Result, IO_state, IO_state):
	%	Returns the elapsed processor time (number of clock
	%	ticks). The base time is arbitrary but doesn't change
	%	within a single process.
	%	If the time cannot be obtained, this procedure
	%	will throw a time_error exception.
	% 
:- pred time__clock(clock_t, io__state, io__state).
:- mode time__clock(out, di, uo) is det.

	% time__clocks_per_sec:
	%	Returns the number of clock ticks per second.
	%
:- func time__clocks_per_sec = int.

	% time__time(Result, IO_state, IO_state):
	%	Returns the current (simple) calendar time.
	%	If the time cannot be obtained, this procedure
	%	will throw a time_error exception.
	%
:- pred time__time(time_t, io__state, io__state).
:- mode time__time(out, di, uo) is det.

	% time__times(ProcessorTime, ElapsedRealTime, IO_state, IO_state)
	%	(POSIX)
	%	Returns the processor time information in the `tms'
	%	value, and the elapsed real time relative to an
	%	arbitrary base in the `clock_t' value.
	%	If the time cannot be obtained, this procedure
	%	will throw a time_error exception.
	%
	%	On non-POSIX systems that do not support this functionality,
	%	this procedure may simply always throw an exception.
	%
:- pred time__times(tms, clock_t, io__state, io__state).
:- mode time__times(out, out, di, uo) is det.

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

	% time__difftime(Time1, Time0) = N:
	%	Computes the number of seconds elapsed between
	%	`Time1' and `Time0'.
	%
:- func time__difftime(time_t, time_t) = int.

	% time__localtime(Time) = TM:
	%	Converts the calendar time `Time' to a broken-down
	%	representation, expressed relative to the user's
	%	specified time zone.
	%
:- func time__localtime(time_t) = tm.

	% time__mktime(TM) = Time:
	%	Converts the broken-down time value to calendar time.
	%	It also normalises the value by filling in day of
	%	week and day of year based on the other components.
	%
:- func time__mktime(tm) = time_t.

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

	% time__asctime(TM) = String:
	% 	Converts the broken-down time value `TM' to a string
	% 	in a standard format.
	%
:- func time__asctime(tm) = string.

	% time__ctime(Time) = String:
	% 	Converts the calendar time value `Time' to a string
	% 	in a standard format.
	%	(ie same as "asctime (localtime (<time>))")
	%
:- func time__ctime(time_t) = string.

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

:- implementation.

:- pragma c_header_code("
	#include <time.h>
	#ifdef HAVE_SYS_TYPES_H
		#include <sys/types.h>
	#endif
	#ifdef HAVE_SYS_TIMES_H
		#include <sys/times.h>
	#endif
").

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

%:- pred time__clock(clock_t, io__state, io__state).
%:- mode time__clock(out, di, uo) is det.

time__clock(Result, IO0, IO) :-
	time__c_clock(Ret, IO0, IO),
	( Ret = -1 ->
		throw(time_error("can't get clock value"))
	;
		Result = Ret
	).

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

:- pragma c_code(time__c_clock(Ret::out, IO0::di, IO::uo),
	[will_not_call_mercury],
"{
	Ret = (Integer) clock();
	update_io(IO0, IO);
}").

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

%:- func time__clocks_per_sec = int.

time__clocks_per_sec = Val :-
	time__c_clocks_per_sec(Val).

:- pred time__c_clocks_per_sec(int).
:- mode time__c_clocks_per_sec(out) is det.

:- pragma c_code(time__c_clocks_per_sec(Ret::out),
	[will_not_call_mercury],
"{
	Ret = (Integer) CLOCKS_PER_SEC;
}").

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

%:- pred time__times(tms, clock_t, io__state, io__state).
%:- mode time__times(out, out, di, uo) is det.

time__times(Tms, Result, IO0, IO) :-
	time__c_times(Ret, Ut, St, CUt, CSt, IO0, IO),
	( Ret = -1 ->
		throw(time_error("can't get times value"))
	;
		Tms = tms(Ut, St, CUt, CSt),
		Result = Ret
	).

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

:- pragma c_code(time__c_times(Ret::out, Ut::out, St::out, CUt::out,
                               CSt::out, IO0::di, IO::uo),
	[will_not_call_mercury],
"{
#ifdef MR_HAVE_POSIX_TIMES
	struct tms t;

	Ret = (Integer) times(&t);

	Ut = (Integer) t.tms_utime;
	St = (Integer) t.tms_stime;
	CUt = (Integer) t.tms_cutime;
	CSt = (Integer) t.tms_cstime;
#else
	Ret = -1
#endif
	update_io(IO0, IO);
}").

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

%:- pred time__time(time_t, io__state, io__state).
%:- mode time__time(out, di, uo) is det.

time__time(Result, IO0, IO) :-
	time__c_time(Ret, IO0, IO),
	( Ret = -1 ->
		throw(time_error("can't get time value"))
	;
		Result = Ret
	).

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

:- pragma c_code(time__c_time(Ret::out, IO0::di, IO::uo),
	[will_not_call_mercury],
"{
	Ret = (Integer) time(NULL);
	update_io(IO0, IO);
}").

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

%:- func time__difftime(time_t, time_t) = int.

time__difftime(T1, T0) = N :-
	time__c_difftime(T1, T0, N).

:- pred time__c_difftime(int, int, int).
:- mode time__c_difftime(in, in, out) is det.

:- pragma c_code(time__c_difftime(T1::in, T0::in, N::out),
	[will_not_call_mercury],
"{
	N = (Integer) difftime((time_t) T1, (time_t) T0);
}").

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

%:- func time__localtime(time_t) = tm.

:- import_module int, exception.

time__localtime(Time) = TM :-
	time__c_localtime(Time, Sec, Min, Hrs, WD, YD, Mnt, Yr, N),
	( N = 0 ->
		DST = yes(standard_time)
	; N > 0 ->
		DST = yes(daylight_time)
	; % N < 0
		DST = no
	),
	TM = tm(Sec, Min, Hrs, WD, YD, Mnt, Yr, DST).

:- pred time__c_localtime(int, int, int, int, int, int, int, int, int).
:- mode time__c_localtime(in, out, out, out, out, out, out, out, out) is det.

:- pragma c_code(time__c_localtime(Time::in, Sec::out, Min::out, Hrs::out,
                                   WD::out, YD::out, Mnt::out,
                                   Yr::out, N::out),
	[will_not_call_mercury],
"{
	struct tm* p;
	time_t t;

	t = Time;

	p = localtime(&t);

	Sec = (Integer) p->tm_sec;
	Min = (Integer) p->tm_min;
	Hrs = (Integer) p->tm_hour;
	Mnt = (Integer) p->tm_mon;
	Yr = (Integer) p->tm_year;
	WD = (Integer) p->tm_wday;
	YD = (Integer) p->tm_yday;
	N = (Integer) p->tm_isdst;
}").

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

%:- func time__mktime(tm) = time_t.

time__mktime(TM) = Time :-
	TM = tm(Sec, Min, Hrs, WD, YD, Mnt, Yr, M),
	( M = yes(DST), DST = daylight_time,
		N = 1
	; M = yes(DST), DST = standard_time,
		N = 0
	; M = no,
		N = -1
	),
	time__c_mktime(Sec, Min, Hrs, WD, YD, Mnt, Yr, N, Time).

:- pred time__c_mktime(int, int, int, int, int, int, int, int, int).
:- mode time__c_mktime(in, in, in, in, in, in, in, in, out) is det.

:- pragma c_code(time__c_mktime(Sec::in, Min::in, Hrs::in, WD::in,
                                YD::in, Mnt::in, Yr::in,
                                N::in, Time::out),
	[will_not_call_mercury],
 "{
	struct tm t;

	t.tm_sec = Sec;
	t.tm_min = Min;
	t.tm_hour = Hrs;
	t.tm_mon = Mnt;
	t.tm_year = Yr;
	t.tm_wday = WD;
	t.tm_yday = YD;
	t.tm_isdst = N;

	Time = (Integer) mktime(&t);
}").

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

%:- func time__asctime(tm) = string.

time__asctime(TM) = Str :-
	TM = tm(Sec, Min, Hrs, WD, YD, Mnt, Yr, M),
	( M = yes(DST), DST = daylight_time,
		N = 1
	; M = yes(DST), DST = standard_time,
		N = 0
	; M = no,
		N = -1
	),
	time__c_asctime(Sec, Min, Hrs, WD, YD, Mnt, Yr, N, Str).

:- pred time__c_asctime(int, int, int, int, int, int, int, int, string).
:- mode time__c_asctime(in, in, in, in, in, in, in, in, out) is det.

:- pragma c_code(time__c_asctime(Sec::in, Min::in, Hrs::in, WD::in,
                                 YD::in, Mnt::in, Yr::in, N::in, Str::out),
	[will_not_call_mercury],
"{
	struct tm t;
	char* s;

	t.tm_sec = Sec;
	t.tm_min = Min;
	t.tm_hour = Hrs;
	t.tm_mon = Mnt;
	t.tm_year = Yr;
	t.tm_wday = WD;
	t.tm_yday = YD;
	t.tm_isdst = N;

	s = asctime(&t);

	MR_make_aligned_string_copy(Str, s);
}").

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

%:- func time__ctime(time_t) = string.

time__ctime(Time) = Str :-
	time__c_ctime(Time, Str).

:- pred time__c_ctime(int, string).
:- mode time__c_ctime(in, out) is det.

:- pragma c_code(time__c_ctime(Time::in, Str::out),
	[will_not_call_mercury],
"{
	char *s;
	time_t t;

	t = Time;

	s = ctime(&t);

	MR_make_aligned_string_copy(Str, s);
}").

%-----------------------------------------------------------------------------%
:- end_module time.
%-----------------------------------------------------------------------------%
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------