%-----------------------------------------------------------------------------%
% Copyright (C) 1993-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 require.

% Main author: fjh.
% Stability: medium to high.

% This module provides features similar to <assert.h> in C.

%-----------------------------------------------------------------------------%
:- interface.

:- pred error(string).
:- mode error(in) is erroneous.

%	error(Message).
%		Abort with error message.


:- pred	require(pred, string).
:- mode	require((pred) is semidet, in) is det.

%	require(Goal, Message).
%		Call goal, and abort with error message if Goal fails.
%		This is not as useful as you might imagine, since it requires
%		that the goal not produce any output variables.  In
%		most circumstances you should use an explicit if-then-else
%		with a call to error/1 in the "else".

:- pred report_lookup_error(string, K, V).
:- mode report_lookup_error(in, in, unused) is erroneous.

%	report_lookup_error(Message, Key, Value)
%		Call error/1 with an error message that is appropriate for
%		the failure of a lookup operation involving the specified
%		Key and Value.  The error message will include Message
%		and information about Key and Value.

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

:- implementation.

:- import_module string, list, std_util.

require(Goal, Message) :-
	( call(Goal) ->
		true
	;
		error(Message),
		fail
	).

report_lookup_error(Msg, K, V) :-
	KeyType = type_name(type_of(K)),
	ValueType = type_name(type_of(V)),
	functor(K, Functor, Arity),
	( Arity = 0 ->
		FunctorStr = Functor
	;
		string__int_to_string(Arity, ArityStr),
		string__append_list([Functor, "/", ArityStr], FunctorStr)
	),
	string__append_list(
		[Msg,
		"\n\tKey Type: ",
		KeyType,
		"\n\tKey Functor: ",
		FunctorStr,
		"\n\tValue Type: ",
		ValueType
		],
		ErrorString),
	error(ErrorString).

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

/* error/1, from require.m */

:- pragma c_header_code("
#include <stdio.h>
#include ""mercury_trace_base.h""
#include ""mercury_stack_trace.h""
").

% Hopefully error/1 won't be called often (!), so no point inlining it.
:- pragma no_inline(error/1). 

error(Message) :- 
	error_internal(Message).

:- pred error_internal(string::in) is erroneous.

% We define error using handwritten code in error_internal because we
% need complete control over it if we want to call MR_dump_stack.  In
% particular we don't want to have to explicitly tell MR_dump_stack whether
% a stack frame was generated by its caller.  The easiest way to do
% this is to make sure it wasn't.

:- external(error_internal/1).

:- pragma c_code("

Define_extern_entry(mercury__require__error_internal_1_0);

BEGIN_MODULE(require_internal_module)
        init_entry(mercury__require__error_internal_1_0);
BEGIN_CODE

/* code for predicate 'error_internal'/1 in mode 0 */
Define_entry(mercury__require__error_internal_1_0);
{
	String  Message;
	Message = (String) r1;

	fflush(stdout);
	fprintf(stderr, ""Software error: %s\\n"", Message);
	MR_trace_report(stderr);
	MR_dump_stack(MR_succip, MR_sp, MR_curfr, FALSE);
	exit(1);
}
END_MODULE

/*
** Ensure that the initialization function for the above module gets run.
*/
/*
INIT sys_init_require_internal_module
*/
extern ModuleFunc require_internal_module;
void sys_init_require_internal_module(void);
void sys_init_require_internal_module(void) {
	require_internal_module();
}
").

:- end_module require.

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