1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2006-2020, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(error, 37 [ instantiation_error/1, % +FormalSubTerm 38 uninstantiation_error/1, % +Culprit 39 type_error/2, % +ValidType, +Culprit 40 domain_error/2, % +ValidDomain, +Culprit 41 existence_error/2, % +ObjectType, +Culprit 42 existence_error/3, % +ObjectType, +Culprit, +Set 43 permission_error/3, % +Operation, +PermissionType, +Culprit 44 representation_error/1, % +Flag 45 resource_error/1, % +Resource 46 syntax_error/1, % +ImplDepAtom 47 48 must_be/2, % +Type, +Term 49 is_of_type/2, % +Type, +Term 50 current_type/3 % ?Type, @Var, -Body 51 ]). 52:- set_prolog_flag(generate_debug_info, false). 53 54/** <module> Error generating support 55 56This module provides predicates to simplify error generation and 57checking. It's implementation is based on a discussion on the SWI-Prolog 58mailinglist on best practices in error handling. The utility predicate 59must_be/2 provides simple run-time type validation. The *_error 60predicates are simple wrappers around throw/1 to simplify throwing the 61most common ISO error terms. 62 63@author Jan Wielemaker 64@author Richard O'Keefe 65@author Ulrich Neumerkel 66@see library(debug) and library(prolog_stack). 67@see print_message/2 is used to print (uncaught) error terms. 68*/ 69 70:- multifile 71 has_type/2. 72 73 /******************************* 74 * ISO ERRORS * 75 *******************************/ 76 77%! type_error(+ValidType, +Culprit). 78% 79% Tell the user that Culprit is not of the expected ValidType. This 80% error is closely related to domain_error/2 because the notion of 81% types is not really set in stone in Prolog. We introduce the 82% difference using a simple example. 83% 84% Suppose an argument must be a non-negative integer. If the actual 85% argument is not an integer, this is a _type_error_. If it is a 86% negative integer, it is a _domain_error_. 87% 88% Typical borderline cases are predicates accepting a compound term, 89% e.g., point(X,Y). One could argue that the basic type is a 90% compound-term and any other compound term is a domain error. Most 91% Prolog programmers consider each compound as a type and would 92% consider a compound that is not point(_,_) a _type_error_. 93 94type_error(ValidType, Culprit) :- 95 throw(error(type_error(ValidType, Culprit), _)). 96 97%! domain_error(+ValidDomain, +Culprit). 98% 99% The argument is of the proper type, but has a value that is outside 100% the supported values. See type_error/2 for a more elaborate 101% discussion of the distinction between type- and domain-errors. 102 103domain_error(ValidDomain, Culprit) :- 104 throw(error(domain_error(ValidDomain, Culprit), _)). 105 106%! existence_error(+ObjectType, +Culprit). 107% 108% Culprit is of the correct type and correct domain, but there is no 109% existing (external) resource of type ObjectType that is represented 110% by it. 111 112existence_error(ObjectType, Culprit) :- 113 throw(error(existence_error(ObjectType, Culprit), _)). 114 115%! existence_error(+ObjectType, +Culprit, +Set). 116% 117% Culprit is of the correct type and correct domain, but there is no 118% existing (external) resource of type ObjectType that is represented 119% by it in the provided set. The thrown exception term carries a 120% formal term structured as follows: existence_error(ObjectType, 121% Culprit, Set) 122% 123% @compat This error is outside the ISO Standard. 124 125existence_error(ObjectType, Culprit, Set) :- 126 throw(error(existence_error(ObjectType, Culprit, Set), _)). 127 128%! permission_error(+Operation, +PermissionType, +Culprit). 129% 130% It is not allowed to perform Operation on (whatever is represented 131% by) Culprit that is of the given PermissionType (in fact, the ISO 132% Standard is confusing and vague about these terms' meaning). 133 134permission_error(Operation, PermissionType, Culprit) :- 135 throw(error(permission_error(Operation, PermissionType, Culprit), _)). 136 137%! instantiation_error(+FormalSubTerm). 138% 139% An argument is under-instantiated. I.e. it is not acceptable as it 140% is, but if some variables are bound to appropriate values it would 141% be acceptable. 142% 143% @param FormalSubTerm is the term that needs (further) 144% instantiation. Unfortunately, the ISO error does not allow 145% for passing this term along with the error, but we pass it 146% to this predicate for documentation purposes and to allow 147% for future enhancement. 148 149instantiation_error(_FormalSubTerm) :- 150 throw(error(instantiation_error, _)). 151 152%! uninstantiation_error(+Culprit) 153% 154% An argument is over-instantiated. This error is used for output 155% arguments whose value cannot be known upfront. For example, the goal 156% open(File, read, input) cannot succeed because the system will 157% allocate a new unique stream handle that will never unify with 158% `input`. 159 160uninstantiation_error(Culprit) :- 161 throw(error(uninstantiation_error(Culprit), _)). 162 163%! representation_error(+Flag). 164% 165% A representation error indicates a limitation of the implementation. 166% SWI-Prolog has no such limits that are not covered by other errors, 167% but an example of a representation error in another Prolog 168% implementation could be an attempt to create a term with an arity 169% higher than supported by the system. 170 171representation_error(Flag) :- 172 throw(error(representation_error(Flag), _)). 173 174%! syntax_error(+Culprit) 175% 176% A text has invalid syntax. The error is described by Culprit. 177% According to the ISO Standard, Culprit should be an 178% implementation-dependent atom. 179% 180% @tbd Deal with proper description of the location of the 181% error. For short texts, we allow for Type(Text), meaning 182% Text is not a valid Type. E.g. syntax_error(number('1a')) 183% means that =1a= is not a valid number. 184 185syntax_error(Culprit) :- 186 throw(error(syntax_error(Culprit), _)). 187 188%! resource_error(+Resource) 189% 190% A goal cannot be completed due to lack of resources. According to 191% the ISO Standard, Resource should be an implementation-dependent 192% atom. 193 194resource_error(Resource) :- 195 throw(error(resource_error(Resource), _)). 196 197 198 /******************************* 199 * MUST-BE * 200 *******************************/ 201 202%! must_be(+Type, @Term) is det. 203% 204% True if Term satisfies the type constraints for Type. Defined 205% types are =atom=, =atomic=, =between=, =boolean=, =callable=, 206% =chars=, =codes=, =text=, =compound=, =constant=, =float=, 207% =integer=, =nonneg=, =positive_integer=, =negative_integer=, 208% =nonvar=, =number=, =oneof=, =list=, =list_or_partial_list=, 209% =symbol=, =var=, =rational=, =encoding=, =dict= and =string=. 210% 211% Most of these types are defined by an arity-1 built-in predicate 212% of the same name. Below is a brief definition of the other 213% types. 214% 215% | acyclic | Acyclic term (tree); see acyclic_term/1 | 216% | any | any term | 217% | between(FloatL,FloatU) | Number [FloatL..FloatU] | 218% | between(IntL,IntU) | Integer [IntL..IntU] | 219% | boolean | One of =true= or =false= | 220% | char | Atom of length 1 | 221% | chars | Proper list of 1-character atoms | 222% | code | Representation Unicode code point | 223% | codes | Proper list of Unicode character codes | 224% | constant | Same as `atomic` | 225% | cyclic | Cyclic term (rational tree); see cyclic_term/1 | 226% | dict | A dictionary term; see is_dict/1 | 227% | encoding | Valid name for a character encoding; see current_encoding/1 | 228% | list | A (non-open) list; see is_list/1 | 229% | negative_integer | Integer < 0 | 230% | nonneg | Integer >= 0 | 231% | oneof(L) | Ground term that is member of L | 232% | pair | Key-Value pair | 233% | positive_integer | Integer > 0 | 234% | proper_list | Same as list | 235% | list(Type) | Proper list with elements of Type | 236% | list_or_partial_list | A list or an open list (ending in a variable); see is_list_or_partial_list/1 | 237% | stream | A stream name or valid stream handle; see is_stream/1 | 238% | symbol | Same as `atom` | 239% | text | One of =atom=, =string=, =chars= or =codes= | 240% | type | Term is a valid type specification | 241% 242% Note: The Windows version can only represent Unicode code points 243% up to 2^16-1. Higher values cause a representation error on most 244% text handling predicates. 245% 246% @throws instantiation_error if Term is insufficiently 247% instantiated and type_error(Type, Term) if Term is not of Type. 248 249must_be(Type, X) :- 250 ( nonvar(Type), 251 has_type(Type, X) 252 -> true 253 ; nonvar(Type) 254 -> is_not(Type, X) 255 ; instantiation_error(Type) 256 ). 257 258%! is_not(+Type, @Term) 259% 260% Throws appropriate error. It is _known_ that Term is not of type 261% Type. 262% 263% @throws type_error(Type, Term) 264% @throws instantiation_error 265 266is_not(list, X) :- 267 !, 268 not_a_list(list, X). 269is_not(list(Of), X) :- 270 !, 271 not_a_list(list(Of), X). 272is_not(list_or_partial_list, X) :- 273 !, 274 type_error(list, X). 275is_not(chars, X) :- 276 !, 277 not_a_list(list(char), X). 278is_not(codes, X) :- 279 !, 280 not_a_list(list(code), X). 281is_not(var,X) :- 282 !, 283 uninstantiation_error(X). 284is_not(cyclic, X) :- 285 domain_error(cyclic_term, X). 286is_not(acyclic, X) :- 287 domain_error(acyclic_term, X). 288is_not(Type, X) :- 289 current_type(Type, _Var, _Body), 290 !, 291 ( var(X) 292 -> instantiation_error(X) 293 ; ground_type(Type), \+ ground(X) 294 -> instantiation_error(X) 295 ; type_error(Type, X) 296 ). 297is_not(Type, _) :- 298 existence_error(type, Type). 299 300ground_type(ground). 301ground_type(oneof(_)). 302ground_type(stream). 303ground_type(text). 304ground_type(string). 305ground_type(rational). 306 307not_a_list(Type, X) :- 308 '$skip_list'(_, X, Rest), 309 ( var(Rest) 310 -> instantiation_error(X) 311 ; Rest == [] 312 -> Type = list(Of), 313 ( nonvar(Of) 314 -> element_is_not(X, Of) 315 ; instantiation_error(Of) 316 ) 317 ; type_error(Type, X) 318 ). 319 320 321element_is_not([H|T], Of) :- 322 has_type(Of, H), 323 !, 324 element_is_not(T, Of). 325element_is_not([H|_], Of) :- 326 !, 327 is_not(Of, H). 328element_is_not(_List, _Of) :- 329 assertion(fail). 330 331%! is_of_type(+Type, @Term) is semidet. 332% 333% True if Term satisfies Type. 334 335is_of_type(Type, Term) :- 336 nonvar(Type), 337 !, 338 has_type(Type, Term), 339 !. 340is_of_type(Type, _) :- 341 instantiation_error(Type). 342 343%! has_type(+Type, @Term) is semidet. 344% 345% True if Term satisfies Type. 346 347:- '$clausable'(has_type/2). % always allow clause/2 348:- public % May be called through current_type/3 349 is_list_or_partial_list/1, 350 current_encoding/1, 351 element_types/2. 352 353has_type(any, _). 354has_type(atom, X) :- atom(X). 355has_type(atomic, X) :- atomic(X). 356has_type(between(L,U), X) :- ( integer(L) 357 -> integer(X), between(L,U,X) 358 ; number(X), X >= L, X =< U 359 ). 360has_type(boolean, X) :- (X==true;X==false), !. 361has_type(callable, X) :- callable(X). 362has_type(char, X) :- '$is_char'(X). 363has_type(code, X) :- '$is_char_code'(X). 364has_type(chars, X) :- '$is_char_list'(X, _Len). 365has_type(codes, X) :- '$is_code_list'(X, _Len). 366has_type(text, X) :- text(X). 367has_type(compound, X) :- compound(X). 368has_type(constant, X) :- atomic(X). 369has_type(float, X) :- float(X). 370has_type(ground, X) :- ground(X). 371has_type(cyclic, X) :- cyclic_term(X). 372has_type(acyclic, X) :- acyclic_term(X). 373has_type(integer, X) :- integer(X). 374has_type(nonneg, X) :- integer(X), X >= 0. 375has_type(positive_integer, X) :- integer(X), X > 0. 376has_type(negative_integer, X) :- integer(X), X < 0. 377has_type(nonvar, X) :- nonvar(X). 378has_type(number, X) :- number(X). 379has_type(oneof(L), X) :- ground(X), \+ \+ memberchk(X, L). 380has_type(pair, X) :- nonvar(X), X = _-_. 381has_type(proper_list, X) :- is_list(X). 382has_type(list, X) :- is_list(X). 383has_type(list_or_partial_list, X) :- is_list_or_partial_list(X). 384has_type(symbol, X) :- atom(X). 385has_type(var, X) :- var(X). 386has_type(rational, X) :- rational(X). 387has_type(string, X) :- string(X). 388has_type(stream, X) :- is_stream(X). 389has_type(encoding, X) :- current_encoding(X). 390has_type(dict, X) :- is_dict(X). 391has_type(list(Type), X) :- is_list(X), element_types(X, Type). 392has_type(type, Type) :- ground(Type), current_type(Type,_,_). 393 394text(X) :- 395 ( atom(X) 396 ; string(X) 397 ; '$is_char_list'(X, _) 398 ; '$is_code_list'(X, _) 399 ), 400 !. 401 402element_types(List, Type) :- 403 nonvar(Type), 404 !, 405 element_types_(List, Type). 406element_types(_List, Type) :- 407 instantiation_error(Type). 408 409element_types_([], _). 410element_types_([H|T], Type) :- 411 has_type(Type, H), 412 !, 413 element_types_(T, Type). 414 415is_list_or_partial_list(L0) :- 416 '$skip_list'(_, L0,L), 417 ( var(L) -> true ; L == [] ). 418 419%! current_encoding(?Name) is nondet. 420% 421% True if Name is the name of a supported encoding. See encoding 422% option of e.g., open/4. 423 424current_encoding(octet). 425current_encoding(ascii). 426current_encoding(iso_latin_1). 427current_encoding(text). 428current_encoding(utf8). 429current_encoding(unicode_be). 430current_encoding(unicode_le). 431current_encoding(wchar_t). 432 433 434%! current_type(?Type, @Var, -Body) is nondet. 435% 436% True when Type is a currently defined type and Var satisfies Type of 437% the body term Body succeeds. 438 439current_type(Type, Var, Body) :- 440 clause(has_type(Type, Var), Body0), 441 qualify(Body0, Body). 442 443qualify(Var, VarQ) :- 444 var(Var), 445 !, 446 VarQ = Var. 447qualify((A0,B0), (A,B)) :- 448 qualify(A0, A), 449 qualify(B0, B). 450qualify(G0, G) :- 451 predicate_property(system:G0, built_in), 452 !, 453 G = G0. 454qualify(G, error:G). 455 456 457 /******************************* 458 * SANDBOX * 459 *******************************/ 460 461:- multifile sandbox:safe_primitive/1. 462 463sandbox:safe_primitive(error:current_type(_,_,_))