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, 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 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_*
 @(Term:any)
  226%

  227%	Succeeds if Term satisfies Type, otherwise fails.

  228%

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

  230%

  231%	| =predicate=						| =atom=/=nonneg=													|

  232%	| =formatted=						| =text=-=list= _or_ =text=											|

  233%	| =formal_error=					| =callable=														|

  234%	| =term_order=						| =oneof=([=, <, >])												|

  235%	| =pair=(=KeyType=-=ValueType=)		| =KeyType=-=ValueType=												|

  236%	| =or=([=Type1=, ..., =TypeN=])		| =Type1= _or_ ... _or_ =TypeN=										|

  237%	| =var=(=SubType=)					| =var= _or_ =SubType=												|

  238%	| =m_var=(=SubType=)				| =atom=:=var= _or_ =atom=:=SubType=								|

  239%	| =m_predicate=						| =atom=:=predicate= _or_ =predicate=								|

  240%	| =m_callable=						| =atom=:=callable= _or_ =callable=									|

  241%	| =s_callable=(_Struct_:=struct=)	| =callable= _and_ =has_struct=(_Struct_, Term) (*)					|

  242%	| =struct=							| =callable= _with_ "_terminals_" =atom= _or_ =var=:=SubType= (*)	|

  243%	| =type=							| =callable= _and_ =clause=(=error=:=has_type=(Term, _))			|

  244%

  245%	(*) The implicit predicate has_struct/2 tests functor equality of

  246%	non-"terminal" sub-terms of _Struct_ to the corresponding sub-terms of

  247%	Term. For "terminal" sub-terms of _Struct_, specifically meaning any

  248%	encountered (sub-)terms of _Struct_ that are of type =var=:=SubType=,

  249%	has_struct/2 tests that the corresponding (sub-)term of Term satisfies

  250%	=SubType=.  (Variable names in "terminals" of _Struct_ are ignored but

  251%	useful for self-documentation.)

  252%	

  253%	@param	Type			The type that Term must satisfy.

  254%	@param	Term			The term to test.

  255%	@error	type_error: invalid argument(s).

  256%	@tbd	Extend type =formal_error= (to ISO?).

  257%	@tbd	Extend type =type= to a proper type specification

  258%			(e.g. =|type_spec(?Type, ?Struct, ?Test, ?Validate)|=) (?).

  259
  260test_type(Type, Term) :-
  261	validate_arg_type_(Type),
  262	test_type_(Type, Term).
 @(Term:any)
  269%

  270%	Succeeds if Term satisfies Type and Constraint, otherwise fails.

  271%

  272%	Supports the types documented in test_type/2.

  273%

  274%	@param	Type			The type that Term must satisfy.

  275%	@param	Constraint		The constraint that Term must satisfy.

  276%	@param	Term			The term to test.

  277%	@error	type_error: invalid argument(s).

  278
  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_*
 + Message:var(formatted)
  294%%
 + Message:var(formatted)
  301%

  302%	Succeeds if Term satisfies Type, otherwise throws

  303%	=|error(type_error(Type, Term), context(Caller, Message))|=.

  304%

  305%	Supports the types documented in test_type/2.

  306%

  307%	NOTE: The variant validate_type/3 is translated to

  308%	validate_type/4 via term rewriting,

  309%	with Caller set to the (qualified) predicate indicator of

  310%	the predicate containing the call.

  311%

  312%	@param	Type			The type that Term must satisfy.

  313%	@param	Term			The term to test.

  314%	@param	Caller			(Optional) A predicate indicator representing the caller.

  315%	@param	Message			(Optional) An error message.

  316%	@error	type_error: invalid argument(s).

  317%	@error	type_error(Type, Term)

  318
  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).
 + Message:var(formatted)
  334%%
 + Message:var(formatted)
  342%

  343%	Succeeds if Term satisfies Type and Constraint, otherwise throws

  344%	=|error(Error, context(Caller, Message))|=,

  345%	where _Error_ is =|type_error(Type, Term)|= or

  346%	=|domain_error(constr(Type, Constraint), Term)|=,

  347%	depending on the case.

  348%

  349%	Supports the types documented in test_type/2.

  350%

  351%	NOTE: The variant validate_domain/4 is translated to

  352%	validate_domain/5 via term rewriting,

  353%	with Caller set to the (qualified) predicate indicator of

  354%	the predicate containing the call.

  355%

  356%	@param	Type			The type that Term must satisfy.

  357%	@param	Constraint		The constraint that Term must satisfy.

  358%	@param	Term			The term to test.

  359%	@param	Caller			(Optional) A predicate indicator representing the caller.

  360%	@param	Message			(Optional) An error message.

  361%	@error	type_error: invalid argument(s).

  362%	@error	type_error(Type, Term)

  363%	@error	domain_error(constr(Type, Constraint), Term)

  364
  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).
 + Message:var(formatted)
  380%%
 + Message:var(formatted)
  387%

  388%	Succeeds if calling Condition succeeds, otherwise throws

  389%	=|error(Error, context(Caller, Message))|=.

  390%

  391%	NOTE: The variant validate_condition/3 is translated to

  392%	validate_condition/4 via term rewriting,

  393%	with Caller set to the (qualified) predicate indicator of

  394%	the predicate containing the call.

  395%

  396%	@param	Condition		The goal representing the validation condition.

  397%	@param	Error			The formal error to throw if Condition fails.

  398%	@param	Caller			(Optional) A predicate indicator representing the caller.

  399%	@param	Message			(Optional) An error message.

  400%	@error	type_error: invalid argument(s).

  401%	@error	Error

  402
  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
 - Exception:exception
  424%%
 - Exception:exception
  432%

  433%	Constructs an exception of the form

  434%	=|error(type_error(Type, Term), context(Caller, Message))|=.

  435%

  436%	Supports the types documented in test_type/2.

  437%

  438%	NOTE: The variant type_exception/4 is translated to

  439%	type_exception/5 via term rewriting,

  440%	with Caller set to the (qualified) predicate indicator of

  441%	the predicate containing the call.

  442%

  443%	@param	Type			The type that Term must satisfy.

  444%	@param	Term			The term to test.

  445%	@param	Caller			(Optional) A predicate indicator representing the caller.

  446%	@param	Message			(Optional) An error message.

  447%	@param	Exception		The resulting exception term.

  448%	@error	type_error: invalid argument(s).

  449
  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).
 - Exception:exception
  466%%
 - Exception:exception
  475%

  476%	Constructs an exception of the form

  477%	=|error(Error, context(Caller, Message))|=,

  478%	where _Error_ is

  479%	=|domain_error(constr(Type, Constraint), Term)|=.

  480%

  481%	Supports the types documented in test_type/2.

  482%

  483%	NOTE: The variant domain_exception/5 is translated to

  484%	domain_exception/6 via term rewriting,

  485%	with Caller set to the (qualified) predicate indicator of

  486%	the predicate containing the call.

  487%

  488%	@param	Type			The type that Term must satisfy.

  489%	@param	Constraint		The constraint that Term must satisfy.

  490%	@param	Term			The term to test.

  491%	@param	Caller			(Optional) A predicate indicator representing the caller.

  492%	@param	Message			(Optional) An error message.

  493%	@param	Exception		The resulting exception term.

  494%	@error	type_error: invalid argument(s).

  495
  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).
 - Exception:exception
  511%%
 - Exception:exception
  518%

  519%	Constructs an exception of the form

  520%	=|error(Error, context(Caller, Message))|=.

  521%

  522%	NOTE: The variant custom_exception/3 is translated to

  523%	custom_exception/4 via term rewriting,

  524%	with Caller set to the (qualified) predicate indicator of

  525%	the predicate containing the call.

  526%

  527%	@param	Error			The formal error.

  528%	@param	Caller			(Optional) A predicate indicator representing the caller.

  529%	@param	Message			(Optional) An error message.

  530%	@param	Exception		The resulting exception term.

  531%	@error	type_error: invalid argument(s).

  532
  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
 - Error:formal_error
  552%

  553%	Constructs a formal error of the form

  554%	=|type_error(Type, Term)|=.

  555%

  556%	Supports the types documented in test_type/2.

  557%

  558%	@param	Type			The type that Term must satisfy.

  559%	@param	Term			The term to test.

  560%	@param	Error			The resulting error term.

  561%	@error	type_error: invalid argument(s).

  562
  563type_error(Type, Term, Error) :-
  564	validate_arg_type_(Type),
  565	type_error_(Type, Term, Error).
 - Error:formal_error
  573%

  574%	Constructs a formal error of the form

  575%	=|domain_error(constr(Type, Constraint), Term)|=.

  576%

  577%	Supports the types documented in test_type/2.

  578%

  579%	@param	Type			The type that Term must satisfy.

  580%	@param	Constraint		The constraint that Term must satisfy.

  581%	@param	Term			The term to test.

  582%	@param	Error			The resulting error term.

  583%	@error	type_error: invalid argument(s).

  584
  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
 - Caller:m_callable
  598%

  599%	Returns in Caller the (qualified) predicate indicator of

  600%	the predicate containing the call.

  601%

  602%	NOTE: An invocation to this predicate is translated

  603%	via term rewriting as shown in the following example:

  604%	

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

  606%		

  607%		==

  608%		my_pred(X) :- ..., current_caller(Caller), ...

  609%		==

  610%		

  611%		The translation would be:

  612%		

  613%		==

  614%		my_pred(X) :- ..., Caller = my_mod:my_pred/1, ...

  615%		==

  616%

  617%	@param	Caller			The qualified predicate indicator for the caller.

  618
  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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%