1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3/*
    4Nan.Validation 1.2
    5Validation Operations
    6nan_validation.pl
    7
    8This file is part of
    9Nan.Common 1.2
   10Common Operations
   11<http://julio.diegidio.name/Projects/Prolog/Download/Nan.Common-0.1.zip>
   12
   13Copyright 2012 J.P. Di Egidio
   14All rights reserved.
   15<http://julio.diegidio.name/Projects/Prolog/Nan.Common>
   16
   17Nan.Common is free software: you can redistribute it and/or modify
   18it under the terms of the GNU General Public License as published by the
   19Free Software Foundation, either version 3 of the License, or (at your
   20option) any later version.
   21
   22Nan.Common is distributed in the hope that it will be useful, but
   23WITHOUT ANY WARRANTY; without even the implied warranty of
   24MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
   25General Public License for more details.
   26
   27You should have received a copy of the GNU General Public License along
   28with Nan.Common. If not, see <http://www.gnu.org/licenses/>.
   29
   30As a special exception, if you link this library with other files,
   31compiled with a Free Software compiler, to produce an executable, this
   32library does not by itself cause the resulting executable to be covered
   33by the GNU General Public License. This exception does not however
   34invalidate any other reasons why the executable file might be covered by
   35the GNU General Public License.
   36
   37Authors:
   38J.P. Di Egidio - JDE - mailto:julio@diegidio.name
   39
   40History:
   411.2.2012-11-11/JDE - Common: minor fixes to the docs and interface.
   421.0.2012-11-10/JDE - Validation: created version 1.0.
   43
   44Written and tested in:
   45SWI-Prolog 6.2.0 - <http://www.swi-prolog.org>
   46*/

   47%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   48%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Nan.Validation 1.2: Validation Operations

Nan.Validation 1.2: Validation Operations (nan_validation)

This module is part of Nan.Common 1.2: Common Operations (nan_common) http://julio.diegidio.name/Projects/Prolog/Nan.Common

This module provides common operations for testing and validation of term types, domains and custom conditions, and for the construction of exception and error terms.

This module abstracts and extends the type testing and validation system provided by library(error). In particular, this module extends to the types that are documented in test_type/2.

NOTE: The type testing and validation system is extensible: specifically, error:has_type/2 is a multifile (and dynamic) predicate. See library(error) for details.

author
- J.P. Di Egidio
version
- 1.2
license
- GPL3 + SWI-Exception
To be done
- Extend the type system beyond error:has_type/2 (for type spec). */
   76:- module(nan_validation,
   77[	%%% INTERFACE: test_*
   78	test_type/2,					% +Type, @Term
   79	test_domain/3,					% +Type, :Constraint, @Term
   80	%%% INTERFACE: validate_*
   81	validate_type/3,				% +Type, @Term, +Message
   82	validate_type/4,				% +Type, @Term, :Caller, +Message
   83	validate_domain/4,				% +Type, :Constraint, @Term, +Message
   84	validate_domain/5,				% +Type, :Constraint, @Term, :Caller, +Message
   85	validate_condition/3,			% :Condition, +Error, +Message
   86	validate_condition/4,			% :Condition, +Error, :Caller, +Message
   87	%%% INTERFACE: *_exception
   88	type_exception/4,				% +Type, @Term, +Message, -Exception
   89	type_exception/5,				% +Type, @Term, :Caller, +Message, -Exception
   90	domain_exception/5,				% +Type, :Constraint, @Term, +Message, -Exception
   91	domain_exception/6,				% +Type, :Constraint, @Term, :Caller, +Message, -Exception
   92	custom_exception/3,				% +Error, +Message, -Exception
   93	custom_exception/4,				% +Error, :Caller, +Message, -Exception
   94	%%% INTERFACE: *_error
   95	type_error/3,					% +Type, @Term, -Error
   96	domain_error/4,					% +Type, :Constraint, @Term, -Error
   97	%%% INTERFACE: current_caller
   98	current_caller/1				% -Caller
   99]).
  100
  101:- use_module(library(error), []).
  102
  103:- meta_predicate
  104	%%% INTERFACE: test_*
  105	test_domain(+, 1, +),
  106	%%% INTERFACE: validate_*
  107	validate_type(+, +, :, +),
  108	validate_domain(+, 1, +, +),
  109	validate_domain(+, 1, +, :, +),
  110	validate_condition(0, +, +),
  111	validate_condition(0, +, :, +),
  112	%%% INTERFACE: *_exception
  113	type_exception(+, +, :, +, -),
  114	domain_exception(+, 1, +, +, -),
  115	domain_exception(+, 1, +, :, +, -),
  116	custom_exception(+, :, +, -),
  117	%%% INTERFACE: *_error
  118	domain_error(+, 1, +, -).
  119
  120%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  121%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  122
  123%%% META-IMPLEMENTATION:
  124
  125expand_term_(Head, TermIn, TermOut) :-
  126	callable(TermIn),
  127	!,
  128	expand_callable_(Head, TermIn, TermOut).
  129expand_term_(_, Term, Term).
  130
  131expand_callable_(Head, GoalIn, GoalOut) :-
  132	functor(GoalIn, throw_no_direct_call_, 0),
  133	!,
  134	expand_get_caller_(Head, Caller),
  135	GoalOut = (
  136		Error = context_error(no_direct_call, Head),
  137		Message = 'For term rewriting only.',
  138		Exception = error(Error, context(Caller, Message)),
  139		throw(Exception)
  140	)
  140.
  141expand_callable_(Head, GoalIn, GoalOut) :-
  142	functor(GoalIn, validate_type, 3),
  143	!,
  144	expand_get_caller_(Head, Caller),
  145	GoalIn = validate_type(Type, Term, Message),
  146	GoalOut = validate_type(Type, Term, Caller, Message)
  146.
  147%
  148expand_callable_(Head, GoalIn, GoalOut) :-
  149	functor(GoalIn, validate_domain, 4),
  150	!,
  151	expand_get_caller_(Head, Caller),
  152	GoalIn = validate_domain(Type, Constraint, Term, Message),
  153	GoalOut = validate_domain(Type, Constraint, Term, Caller, Message)
  153.
  154%
  155expand_callable_(Head, GoalIn, GoalOut) :-
  156	functor(GoalIn, validate_condition, 3),
  157	!,
  158	expand_get_caller_(Head, Caller),
  159	GoalIn = validate_condition(Condition, Error, Message),
  160	GoalOut = validate_condition(Condition, Error, Caller, Message)
  160.
  161%
  162expand_callable_(Head, GoalIn, GoalOut) :-
  163	functor(GoalIn, type_exception, 4),
  164	!,
  165	expand_get_caller_(Head, Caller),
  166	GoalIn = type_exception(Type, Term, Message, Exception),
  167	GoalOut = type_exception(Type, Term, Caller, Message, Exception)
  167.
  168%
  169expand_callable_(Head, GoalIn, GoalOut) :-
  170	functor(GoalIn, domain_exception, 5),
  171	!,
  172	expand_get_caller_(Head, Caller),
  173	GoalIn = domain_exception(Type, Constraint, Term, Message, Exception),
  174	GoalOut = domain_exception(
  175		Type, Constraint, Term, Caller, Message, Exception
  176	)
  176.
  177%
  178expand_callable_(Head, GoalIn, GoalOut) :-
  179	functor(GoalIn, custom_exception, 3),
  180	!,
  181	expand_get_caller_(Head, Caller),
  182	GoalIn = custom_exception(Error, Message, Exception),
  183	GoalOut = custom_exception(Error, Caller, Message, Exception)
  183.
  184%
  185expand_callable_(Head, GoalIn, GoalOut) :-
  186	functor(GoalIn, current_caller, 1),
  187	GoalIn = current_caller(CallerVar),
  188	var(CallerVar),
  189	!,
  190	expand_get_caller_(Head, Caller),
  191	GoalOut = (CallerVar = Caller)
  191.
  192%
  193expand_callable_(Head, GoalIn, GoalOut) :-
  194	GoalIn =.. [GName| GArgsIn],
  195	expand_callable__loop(Head, GArgsIn, GArgsOut),
  196	GoalOut =.. [GName| GArgsOut].
  197
  198expand_callable__loop(Head, [GAIn| GArgsIn], [GAOut| GArgsOut]) :-
  199	!,
  200	expand_term_(Head, GAIn, GAOut),
  201	expand_callable__loop(Head, GArgsIn, GArgsOut).
  202expand_callable__loop(_, [], []).
  203
  204expand_get_caller_(Head, Caller) :-
  205	context_module(Module),
  206	functor(Head, Name, Arity),
  207	Caller = Module:Name/Arity.
  208
  209%%%	system:term_expansion(+TermIn, -TermOut) is det.
  210
  211:- multifile
  212	system:term_expansion/2.
  213
  214system:term_expansion((Head :- BodyIn), (Head :- BodyOut)) :-
  215	nan_validation:expand_term_(Head, BodyIn, BodyOut).
  216
  217%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  218%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  219
  220%%% INTERFACE: test_*
 test_type(+Type:type, @Term:any) is semidet
Succeeds if Term satisfies Type, otherwise fails.

Supports all types documented in error:must_be/2 plus those listed here:

predicateatom/nonneg
formattedtext-list or text
formal_errorcallable
term_orderoneof([=, <, >])
pair(KeyType-ValueType)KeyType-ValueType
or([Type1, ..., TypeN])Type1 or ... or TypeN
var(SubType)var or SubType
m_var(SubType)atom:var or atom:SubType
m_predicateatom:predicate or predicate
m_callableatom:callable or callable
s_callable(Struct:struct)callable and has_struct(Struct, Term) (*)
structcallable with "_terminals_" atom or var:SubType (*)
typecallable and clause(error:has_type(Term, _))

(*) The implicit predicate has_struct/2 tests functor equality of non-"terminal" sub-terms of Struct to the corresponding sub-terms of Term. For "terminal" sub-terms of Struct, specifically meaning any encountered (sub-)terms of Struct that are of type var:SubType, has_struct/2 tests that the corresponding (sub-)term of Term satisfies SubType. (Variable names in "terminals" of Struct are ignored but useful for self-documentation.)

Arguments:
Type- The type that Term must satisfy.
Term- The term to test.
Errors
- type_error: invalid argument(s).
To be done
- Extend type formal_error (to ISO?).
- Extend type type to a proper type specification (e.g. type_spec(?Type, ?Struct, ?Test, ?Validate)) (?).
  260test_type(Type, Term) :-
  261	validate_arg_type_(Type),
  262	test_type_(Type, Term).
 test_domain(+Type:type, :Constraint:m_callable, @Term:any) is semidet
Succeeds if Term satisfies Type and Constraint, otherwise fails.

Supports the types documented in test_type/2.

Arguments:
Type- The type that Term must satisfy.
Constraint- The constraint that Term must satisfy.
Term- The term to test.
Errors
- type_error: invalid argument(s).
  279test_domain(Type, Constraint, Term) :-
  280	validate_arg_type_(Type),
  281	validate_arg_constraint_(Constraint),
  282	test_domain_(Type, Constraint, Term).
  283
  284%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  285%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  286
  287%%% INTERFACE: validate_*
 validate_type(+Type:type, @Term:any, +Message:var(formatted)) is det
 validate_type(+Type:type, @Term:any, :Caller:m_var(predicate), +Message:var(formatted)) is det
Succeeds if Term satisfies Type, otherwise throws error(type_error(Type, Term), context(Caller, Message)).

Supports the types documented in test_type/2.

NOTE: The variant validate_type/3 is translated to validate_type/4 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.

Arguments:
Type- The type that Term must satisfy.
Term- The term to test.
Caller- (Optional) A predicate indicator representing the caller.
Message- (Optional) An error message.
Errors
- type_error: invalid argument(s).
- type_error(Type, Term)
  319validate_type(_, _, _) :-
  320	throw_no_direct_call_.
  321
  322validate_type(Type, Term, Caller, Message) :-
  323	validate_arg_type_(Type),
  324	validate_arg_caller_(Caller),
  325	validate_arg_message_(Message),
  326	validate_type_(Type, Term, Caller, Message).
 validate_domain(+Type:type, :Constraint:m_callable, @Term:any, +Message:var(formatted)) is det
 validate_domain(+Type:type, :Constraint:m_callable, @Term:any, :Caller:m_var(predicate), +Message:var(formatted)) is det
Succeeds if Term satisfies Type and Constraint, otherwise throws error(Error, context(Caller, Message)), where Error is type_error(Type, Term) or domain_error(constr(Type, Constraint), Term), depending on the case.

Supports the types documented in test_type/2.

NOTE: The variant validate_domain/4 is translated to validate_domain/5 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.

Arguments:
Type- The type that Term must satisfy.
Constraint- The constraint that Term must satisfy.
Term- The term to test.
Caller- (Optional) A predicate indicator representing the caller.
Message- (Optional) An error message.
Errors
- type_error: invalid argument(s).
- type_error(Type, Term)
- domain_error(constr(Type, Constraint), Term)
  365validate_domain(_, _, _, _) :-
  366	throw_no_direct_call_.
  367
  368validate_domain(Type, Constraint, Term, Caller, Message) :-
  369	validate_arg_type_(Type),
  370	validate_arg_constraint_(Constraint),
  371	validate_arg_caller_(Caller),
  372	validate_arg_message_(Message),
  373	validate_domain_(Type, Constraint, Term, Caller, Message).
 validate_condition(:Condition:m_callable, +Error:formal_error, +Message:var(formatted)) is det
 validate_condition(:Condition:m_callable, +Error:formal_error, :Caller:m_var(predicate), +Message:var(formatted)) is det
Succeeds if calling Condition succeeds, otherwise throws error(Error, context(Caller, Message)).

NOTE: The variant validate_condition/3 is translated to validate_condition/4 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.

Arguments:
Condition- The goal representing the validation condition.
Error- The formal error to throw if Condition fails.
Caller- (Optional) A predicate indicator representing the caller.
Message- (Optional) An error message.
Errors
- type_error: invalid argument(s).
- Error
  403validate_condition(_, _, _) :-
  404	throw_no_direct_call_.
  405
  406validate_condition(Condition, Error, Caller, Message) :-
  407	validate_arg_condition_(Condition),
  408	validate_arg_error_(Error),
  409	validate_arg_caller_(Caller),
  410	validate_arg_message_(Message),
  411	validate_condition_(Condition, Error, Caller, Message).
  412
  413%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  414%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  415
  416%%% INTERFACE: *_exception
 type_exception(+Type:type, @Term:any, +Message:var(formatted), -Exception:exception) is det
 type_exception(+Type:type, @Term:any, :Caller:m_var(predicate), +Message:var(formatted), -Exception:exception) is det
Constructs an exception of the form error(type_error(Type, Term), context(Caller, Message)).

Supports the types documented in test_type/2.

NOTE: The variant type_exception/4 is translated to type_exception/5 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.

Arguments:
Type- The type that Term must satisfy.
Term- The term to test.
Caller- (Optional) A predicate indicator representing the caller.
Message- (Optional) An error message.
Exception- The resulting exception term.
Errors
- type_error: invalid argument(s).
  450type_exception(_, _, _, _) :-
  451	throw_no_direct_call_.
  452
  453type_exception(Type, Term, Caller, Message, Exception) :-
  454	validate_arg_type_(Type),
  455	validate_arg_caller_(Caller),
  456	validate_arg_message_(Message),
  457	type_exception_(Type, Term, Caller, Message, Exception).
 domain_exception(+Type:type, :Constraint:m_callable, @Term:any, +Message:var(formatted), -Exception:exception) is det
 domain_exception(+Type:type, :Constraint:m_callable, @Term:any, :Caller:m_var(predicate), +Message:var(formatted), -Exception:exception) is det
Constructs an exception of the form error(Error, context(Caller, Message)), where Error is domain_error(constr(Type, Constraint), Term).

Supports the types documented in test_type/2.

NOTE: The variant domain_exception/5 is translated to domain_exception/6 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.

Arguments:
Type- The type that Term must satisfy.
Constraint- The constraint that Term must satisfy.
Term- The term to test.
Caller- (Optional) A predicate indicator representing the caller.
Message- (Optional) An error message.
Exception- The resulting exception term.
Errors
- type_error: invalid argument(s).
  496domain_exception(_, _, _, _, _) :-
  497	throw_no_direct_call_.
  498
  499domain_exception(Type, Constraint, Term, Caller, Message, Exception) :-
  500	validate_arg_type_(Type),
  501	validate_arg_constraint_(Constraint),
  502	validate_arg_caller_(Caller),
  503	validate_arg_message_(Message),
  504	domain_exception_(Type, Constraint, Term, Caller, Message, Exception).
 custom_exception(+Error:formal_error, +Message:var(formatted), -Exception:exception) is det
 custom_exception(+Error:formal_error, :Caller:m_var(predicate), +Message:var(formatted), -Exception:exception) is det
Constructs an exception of the form error(Error, context(Caller, Message)).

NOTE: The variant custom_exception/3 is translated to custom_exception/4 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.

Arguments:
Error- The formal error.
Caller- (Optional) A predicate indicator representing the caller.
Message- (Optional) An error message.
Exception- The resulting exception term.
Errors
- type_error: invalid argument(s).
  533custom_exception(_, _, _) :-
  534	throw_no_direct_call_.
  535
  536custom_exception(Error, Caller, Message, Exception) :-
  537	validate_arg_error_(Error),
  538	validate_arg_caller_(Caller),
  539	validate_arg_message_(Message),
  540	custom_exception_(Error, Caller, Message, Exception).
  541
  542%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  543%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  544
  545%%% INTERFACE: *_error
 type_error(+Type:type, @Term:any, -Error:formal_error) is det
Constructs a formal error of the form type_error(Type, Term).

Supports the types documented in test_type/2.

Arguments:
Type- The type that Term must satisfy.
Term- The term to test.
Error- The resulting error term.
Errors
- type_error: invalid argument(s).
  563type_error(Type, Term, Error) :-
  564	validate_arg_type_(Type),
  565	type_error_(Type, Term, Error).
 domain_error(+Type:type, :Constraint:m_callable, @Term:any, -Error:formal_error) is det
Constructs a formal error of the form domain_error(constr(Type, Constraint), Term).

Supports the types documented in test_type/2.

Arguments:
Type- The type that Term must satisfy.
Constraint- The constraint that Term must satisfy.
Term- The term to test.
Error- The resulting error term.
Errors
- type_error: invalid argument(s).
  585domain_error(Type, Constraint, Term, Error) :-
  586	validate_arg_type_(Type),
  587	validate_arg_constraint_(Constraint),
  588	domain_error_(Type, Constraint, Term, Error).
  589
  590%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  591%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  592
  593%%% INTERFACE: current_caller
 current_caller(-Caller:m_callable) is det
Returns in Caller the (qualified) predicate indicator of the predicate containing the call.

NOTE: An invocation to this predicate is translated via term rewriting as shown in the following example:

For a predicate =my_mod:my_pred/1= such as:

==
my_pred(X) :- ..., current_caller(Caller), ...
==

The translation would be:

==
my_pred(X) :- ..., Caller = my_mod:my_pred/1, ...
==
Arguments:
Caller- The qualified predicate indicator for the caller.
  619current_caller(_) :-
  620	throw_no_direct_call_.
  621
  622%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  623%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  624
  625%%% IMPLEMENTATION:
  626
  627%%%	error:has_type(+Type, @Term) is semidet.
  628
  629:- multifile
  630	error:has_type/2.
  631
  632error:has_type(predicate, Term) :-					% predicate
  633	nonvar(Term),
  634	Term = Name/Arity,
  635	atom(Name),
  636	error:has_type(nonneg, Arity).
  637error:has_type(formatted, Term) :-					% formatted
  638	nonvar(Term),
  639	(	Term = Format-Args
  640	->	error:has_type(list, Args)
  641	;	Term = Format
  642	),
  643	error:has_type(text, Format).
  644error:has_type(formal_error, Term) :-				% formal_error
  645	callable(Term).
  646error:has_type(term_order, Term) :-					% term_order
  647	error:has_type(oneof([=, <, >]), Term).
  648error:has_type(pair(KeyType-ValueType), Term) :-	% pair(KeyType-ValueType)
  649	nonvar(Term),
  650	Term = Key-Value,
  651	error:has_type(KeyType, Key),
  652	error:has_type(ValueType, Value).
  653error:has_type(or(Types), Term) :-					% or([Type1, ..., TypeN])
  654	error:has_type(list, Types),
  655	is_type_or_(Types, Term).
  656error:has_type(var(SubType), Term) :-				% var(SubType)
  657	(	var(Term)
  658	->	true
  659	;	error:has_type(SubType, Term)
  660	).
  661error:has_type(m_var(SubType), Term) :-				% m_var(SubType)
  662	stripped_module_(Term, SubTerm),
  663	(	var(SubTerm)
  664	->	true
  665	;	error:has_type(SubType, SubTerm)
  666	).
  667error:has_type(m_predicate, Term) :-				% m_predicate
  668	stripped_module_(Term, PredInd),
  669	error:has_type(predicate, PredInd).
  670error:has_type(m_callable, Term) :-					% m_callable
  671	stripped_module_(Term, Callable),
  672	callable(Callable).
  673error:has_type(s_callable(Struct), Term) :-			% s_callable(Struct)
  674	has_struct_(Struct, Term).
  675error:has_type(struct, Term) :-						% struct
  676	is_struct_(Term).
  677error:has_type(type, Term) :-						% type
  678	callable(Term),
  679	\+ \+ once(clause(error:has_type(Term, _), _)).
  680
  681is_type_or_([Type| Types], Term) :-
  682	(	error:has_type(Type, Term)
  683	->	true
  684	;	is_type_or_(Types, Term)
  685	).
  686
  687stripped_module_(Term, SubTerm) :-
  688	nonvar(Term),
  689	(	Term = Module:SubTerm
  690	->	atom(Module)
  691	;	Term = SubTerm
  692	).
  693
  694is_struct_(Term) :-
  695	callable(Term),
  696	is_struct__case(Term).
  697
  698is_struct__case(Term) :-
  699	atom(Term),
  700	!.
  701is_struct__case(Term) :-
  702	Term = Var:VType,
  703	var(Var),
  704	!,
  705	error:has_type(type, VType).
  706is_struct__case(Term) :-
  707	Term =.. [_| SubTerms],
  708	is_struct__loop(SubTerms).
  709
  710is_struct__loop([Term| Terms]) :-
  711	is_struct_(Term),
  712	is_struct__loop(Terms).
  713is_struct__loop([]).
  714
  715has_struct_(Struct, Term) :-
  716	callable(Struct),
  717	has_struct__case(Struct, Term).
  718
  719has_struct__case(Struct, Term) :-
  720	atom(Struct),
  721	!,
  722	Term == Struct.
  723has_struct__case(Struct, Term) :-
  724	Struct = Var:VType,
  725	var(Var),
  726	!,
  727	error:has_type(VType, Term).
  728has_struct__case(Struct, Term) :-
  729	compound(Term),
  730	functor(Struct, Name, Arity),
  731	functor(Term, Name, Arity),
  732	Struct =.. [Name| SubStructs],
  733	Term =.. [Name| SubTerms],
  734	has_struct__loop(SubStructs, SubTerms).
  735
  736has_struct__loop([Struct| Structs], [Term| Terms]) :-
  737	has_struct_(Struct, Term),
  738	has_struct__loop(Structs, Terms).
  739has_struct__loop([], []).
 validate_arg_type_(@Type) is det
 validate_arg_constraint_(@Constraint) is det
 validate_arg_condition_(@Condition) is det
 validate_arg_error_(@Error) is det
 validate_arg_caller_(@Caller) is det
 validate_arg_message_(@Message) is det
  748validate_arg_type_(Type) :-
  749	validate_type_(type, Type, _, _).
  750
  751validate_arg_constraint_(Constraint) :-
  752	validate_type_(m_callable, Constraint, _, _).
  753
  754validate_arg_condition_(Condition) :-
  755	validate_type_(m_callable, Condition, _, _).
  756
  757validate_arg_error_(Error) :-
  758	validate_type_(formal_error, Error, _, _).
  759
  760validate_arg_caller_(Caller) :-
  761	validate_type_(m_var(predicate), Caller, _, _).
  762
  763validate_arg_message_(Message) :-
  764	validate_type_(var(formatted), Message, _, _).
 test_type_(+Type, @Term) is semidet
 test_domain_(+Type, :Constraint, @Term) is semidet
  769test_type_(Type, Term) :-
  770	error:has_type(Type, Term).
  771
  772test_domain_(Type, Constraint, Term) :-
  773	error:has_type(Type, Term),
  774	call(Constraint, Term).
 validate_type_(+Type, @Term, :Caller, +Message) is det
 validate_domain_(+Type, :Constraint, @Term, :Caller, +Message) is det
 validate_condition_(:Condition, +Error, :Caller, +Message) is det
  780validate_type_(Type, Term, Caller, Message) :-
  781	validate_(
  782		error:has_type(Type, Term),
  783		type_exception_(Type, Term, Caller, Message)
  784	).
  785
  786validate_domain_(Type, Constraint, Term, Caller, Message) :-
  787	validate_type_(Type, Term, Caller, Message),
  788	validate_(
  789		call(Constraint, Term),
  790		domain_exception_(Type, Constraint, Term, Caller, Message)
  791	).
  792
  793validate_condition_(Condition, Error, Caller, Message) :-
  794	validate_(
  795		call(Condition),
  796		custom_exception_(Error, Caller, Message)
  797	).
 validate_(:Validate, :CreateEx) is det
  801validate_(Validate, _) :-
  802	call(Validate),
  803	!.
  804validate_(_, CreateEx) :-
  805	call(CreateEx, Exception),
  806	throw(Exception).
 type_exception_(+Type, @Term, :Caller, +Message, -Exception) is det
 domain_exception_(+Type, :Constraint, @Term, :Caller, +Message, -Exception) is det
 custom_exception_(+Error, :Caller, +Message, -Exception) is det
  812type_exception_(Type, Term, Caller, Message, Exception) :-
  813	type_error_(Type, Term, Error),
  814	custom_exception_(Error, Caller, Message, Exception).
  815
  816domain_exception_(Type, Constraint, Term, Caller, Message, Exception) :-
  817	domain_error_(Type, Constraint, Term, Error),
  818	custom_exception_(Error, Caller, Message, Exception).
  819
  820custom_exception_(Error, Caller, Message, Exception) :-
  821	Exception = error(Error, context(Caller, Message)).
 type_error_(+Type, @Term, -Error) is det
 domain_error_(+Type, :Constraint, @Term, -Error) is det
  826type_error_(Type, Term, Error) :-
  827	Error = type_error(Type, Term).
  828
  829domain_error_(Type, Constraint, Term, Error) :-
  830	Domain = constr(Type, Constraint),
  831	Error = domain_error(Domain, Term).
  832
  833%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  834%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%