251 lines
7.0 KiB
Prolog
251 lines
7.0 KiB
Prolog
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
Written 2018-2025 by Markus Triska (triska@metalevel.at)
|
|
I place this code in the public domain. Use it in any way you want.
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
:- module(error, [must_be/2,
|
|
can_be/2,
|
|
instantiation_error/1,
|
|
domain_error/3,
|
|
type_error/3,
|
|
call_with_error_context/2
|
|
]).
|
|
|
|
|
|
:- meta_predicate check_(1, ?, ?).
|
|
|
|
|
|
%% must_be(Type, Term)
|
|
%
|
|
% This predicate is intended for type-checks of built-in predicates.
|
|
%
|
|
% It asserts that Term is:
|
|
%
|
|
% 1) instantiated *and*
|
|
% 2) instantiated to an instance of the given Type.
|
|
%
|
|
% It corresponds to usage mode +Term.
|
|
%
|
|
% Currently, the following types are supported:
|
|
%
|
|
% - atom
|
|
% - boolean
|
|
% - character
|
|
% - chars
|
|
% - in_character
|
|
% - integer
|
|
% - list
|
|
% - octet_character
|
|
% - octet_chars
|
|
% - pair
|
|
% - term
|
|
|
|
must_be(Type, Term) :-
|
|
must_be_(type, Type),
|
|
must_be_(Type, Term).
|
|
|
|
must_be_(Type, _) :-
|
|
var(Type),
|
|
instantiation_error(must_be/2).
|
|
must_be_(var, Term) :-
|
|
( var(Term) -> true
|
|
; throw(error(uninstantiation_error(Term), must_be/2))
|
|
).
|
|
must_be_(integer, Term) :- check_(integer, integer, Term).
|
|
must_be_(not_less_than_zero, N) :-
|
|
must_be(integer, N),
|
|
( N >= 0 -> true
|
|
; domain_error(not_less_than_zero, N, must_be/2)
|
|
).
|
|
must_be_(atom, Term) :- check_(atom, atom, Term).
|
|
must_be_(character, T) :- check_(error:character, character, T).
|
|
must_be_(in_character, T) :- check_(error:in_character, in_character, T).
|
|
must_be_(chars, Ls) :-
|
|
can_be(chars, Ls), % prioritize type errors over instantiation errors
|
|
must_be(list, Ls),
|
|
( '$is_partial_string'(Ls) ->
|
|
% The expected case (success) uses a very fast test.
|
|
% We cannot use partial_string/1 from library(iso_ext),
|
|
% because that library itself imports library(error).
|
|
true
|
|
; all_characters(Ls)
|
|
).
|
|
must_be_(octet_character, C) :-
|
|
must_be(character, C),
|
|
( octet_character(C) -> true
|
|
; domain_error(octet_character, C, must_be/2)
|
|
).
|
|
must_be_(octet_chars, Cs) :-
|
|
must_be(chars, Cs),
|
|
( '$first_non_octet'(Cs, C) ->
|
|
domain_error(octet_character, C, must_be/2)
|
|
; true
|
|
).
|
|
must_be_(list, Term) :- check_(error:ilist, list, Term).
|
|
must_be_(list(Elem), Term) :-
|
|
must_be_(list, Term),
|
|
check_all(Elem, Term).
|
|
must_be_(type, Term) :- check_(error:type, type, Term).
|
|
must_be_(boolean, Term) :- check_(error:boolean, boolean, Term).
|
|
must_be_(pair, Term) :- check_(error:pair, pair, Term).
|
|
must_be_(term, Term) :-
|
|
( acyclic_term(Term) ->
|
|
( ground(Term) -> true
|
|
; instantiation_error(must_be/2)
|
|
)
|
|
; type_error(term, Term, must_be/2)
|
|
).
|
|
|
|
% We cannot use maplist(must_be(character), Cs), because library(lists)
|
|
% uses library(error), so importing it would create a cyclic dependency.
|
|
|
|
check_all(_, []).
|
|
check_all(Type, [Head| Tail]) :-
|
|
must_be(Type, Head),
|
|
check_all(Type, Tail).
|
|
|
|
all_characters(Cs) :- check_all(character, Cs).
|
|
|
|
check_(Pred, Type, Term) :-
|
|
( var(Term) -> instantiation_error(must_be/2)
|
|
; call(Pred, Term) -> true
|
|
; type_error(Type, Term, must_be/2)
|
|
).
|
|
|
|
|
|
pair(_-_).
|
|
|
|
boolean(B) :- ( B == true ; B == false ).
|
|
|
|
character(C) :-
|
|
atom(C),
|
|
atom_length(C, 1).
|
|
|
|
octet_character(C) :-
|
|
char_code(C, Code),
|
|
0 =< Code, Code =< 0xff.
|
|
|
|
in_character(C) :-
|
|
( character(C)
|
|
; C == end_of_file
|
|
).
|
|
|
|
ilist(Ls) :-
|
|
'$skip_max_list'(_, _, Ls, Rs),
|
|
( var(Rs) ->
|
|
instantiation_error(must_be/2)
|
|
; Rs == []
|
|
).
|
|
|
|
type(type).
|
|
type(integer).
|
|
type(atom).
|
|
type(character).
|
|
type(in_character).
|
|
type(octet_character).
|
|
type(octet_chars).
|
|
type(chars).
|
|
type(list).
|
|
type(list(Type)) :- type(Type).
|
|
type(var).
|
|
type(boolean).
|
|
type(term).
|
|
type(not_less_than_zero).
|
|
type(pair).
|
|
|
|
%% can_be(Type, Term)
|
|
%
|
|
% This predicate is intended for type-checks of built-in predicates.
|
|
%
|
|
% It asserts that there is a substitution which, if applied to Term,
|
|
% makes it an instance of Type.
|
|
%
|
|
% It corresponds to usage mode ?Term.
|
|
%
|
|
% It supports the same types as must_be/2.
|
|
|
|
can_be(Type, Term) :-
|
|
must_be(type, Type),
|
|
( var(Term) -> true
|
|
; can_(Type, Term) -> true
|
|
; type_error(Type, Term, can_be/2)
|
|
).
|
|
|
|
can_(integer, Term) :- integer(Term).
|
|
can_(not_less_than_zero, N) :-
|
|
( integer(N) ->
|
|
( N >= 0 -> true
|
|
; domain_error(not_less_than_zero, N, can_be/2)
|
|
)
|
|
; type_error(integer, N, can_be/2)
|
|
).
|
|
can_(atom, Term) :- atom(Term).
|
|
can_(character, T) :- character(T).
|
|
can_(in_character, T) :- in_character(T).
|
|
can_(chars, Ls) :-
|
|
( '$is_partial_string'(Ls) -> true
|
|
; can_be(list, Ls),
|
|
can_be_chars(Ls)
|
|
).
|
|
can_(octet_character, C) :-
|
|
( octet_character(C) -> true
|
|
; domain_error(octet_character, C, can_be/2)
|
|
).
|
|
can_(octet_chars, Cs) :-
|
|
can_be(chars, Cs),
|
|
( '$skip_max_list'(_, _, Cs, []), % temporarily turn Cs into a list
|
|
'$first_non_octet'(Cs, C) ->
|
|
domain_error(octet_character, C, can_be/2)
|
|
; true
|
|
).
|
|
can_(list, Term) :- list_or_partial_list(Term).
|
|
can_(boolean, Term) :- boolean(Term).
|
|
can_(pair, Term) :- pair(Term).
|
|
can_(term, Term) :-
|
|
( acyclic_term(Term) ->
|
|
true
|
|
; type_error(term, Term, can_be/2)
|
|
).
|
|
|
|
can_be_chars(Var) :- var(Var), !.
|
|
can_be_chars([]).
|
|
can_be_chars([X|Xs]) :-
|
|
can_be(character, X),
|
|
can_be_chars(Xs).
|
|
|
|
list_or_partial_list(Ls) :-
|
|
'$skip_max_list'(_, _, Ls, Rs),
|
|
( var(Rs) -> true
|
|
; Rs == []
|
|
).
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
Shorthands for throwing ISO errors.
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
instantiation_error(Context) :-
|
|
throw(error(instantiation_error, Context)).
|
|
|
|
domain_error(Type, Term, Context) :-
|
|
throw(error(domain_error(Type, Term), Context)).
|
|
|
|
type_error(Type, Term, Context) :-
|
|
throw(error(type_error(Type, Term), Context)).
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
call_with_error_context/2
|
|
|
|
See https://github.com/mthom/scryer-prolog/discussions/2839 .
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
%% call_with_error_context(+Goal, +Pair)
|
|
%
|
|
% Call _Goal_ with error context _Pair_.
|
|
%
|
|
% Examples of error contexts: `predicate-PI`, `file-Filename` etc.
|
|
|
|
:- meta_predicate(call_with_error_context(0,+)).
|
|
call_with_error_context(G_0, Pair) :-
|
|
must_be(pair, Pair),
|
|
catch(G_0, error(E,Pairs), throw(error(E,[Pair|Pairs]))).
|