diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix current_predicate/1 and arg/3

This commit is contained in:
Vitor Santos Costa 2016-08-02 11:34:58 -05:00
parent d54446d736
commit 79a154cbf4
5 changed files with 109 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
C/cdmgr.c
View File

@ -138,8 +138,10 @@ restart:
goto restart;
}
return RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
} else
return NULL;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
/** Look for a predicate with same functor as t,

3
C/inlines.c
View File

@ -665,6 +665,7 @@ p_arg( USES_REGS1 )
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
return(FALSE);
}
save_hb();
@ -708,7 +709,7 @@ p_arg( USES_REGS1 )
ENDP(pt0);
}
else {
/* Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3"); */
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
return(FALSE);
}

32
C/prim_absmi_insts.h
View File

@ -2390,6 +2390,9 @@
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
FAIL();
}
if ((Int)d0 <= 0 ||
@ -2427,12 +2430,9 @@
ENDP(pt0);
}
else {
/*
don't complain here for SWI Prolog compatibility
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
*/
FAIL();
}
@ -2481,6 +2481,9 @@
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
FAIL();
}
if ((Int)d0 <= 0 ||
@ -2518,12 +2521,9 @@
ENDP(pt0);
}
else {
/*
keep SWI Prolog compatibility, just fail on trying to obtain an argument of a compound term.
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
*/
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
FAIL();
}
@ -2579,6 +2579,9 @@
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
FAIL();
}
if ((Int)d0 <= 0 ||
@ -2622,12 +2625,9 @@
ENDP(pt0);
}
else {
/*
don't complain here for SWI Prolog compatibility
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
*/
FAIL();
}
@ -2677,7 +2677,10 @@
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
FAIL();
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
FAIL();
}
if ((Int)d0 <= 0 ||
(Int)d0 > ArityOfFunctor((Functor) d1)) {
@ -2720,12 +2723,9 @@
ENDP(pt0);
}
else {
/*
don't complain here for SWI Prolog compatibility
saveregs();
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
setregs();
*/
FAIL();
}

65
pl/error.yap
View File

@ -18,6 +18,7 @@
existence_error/2, % +Type, +Term
permission_error/3, % +Action, +Type, +Term
must_be_instantiated/1, % +Term
must_bind_to_type/2, % +Type, ?Term
instantiation_error/1, % +Term
representation_error/1, % +Reason
is_of_type/2 % +Type, +Term
@ -139,6 +140,12 @@ must_be_of_type(Type, X, _Comment) :-
; is_not(Type, X)
).
must_bind_to_type(Type, X) :-
( may_bind_to_type(Type, X), writeln(X)
-> true
; is_not(Type, X)
).
%% @predicate is_not(+Type, @Term)
%
% Throws appropriate error. It is _known_ that Term is not of type
@ -237,6 +244,64 @@ has_type(string, X) :- string(X).
has_type(stream, X) :- is_stream(X).
has_type(list(Type), X) :- is_list(X), element_types(X, Type).
%% may_bind_to_type(+Type, @Term) is semidet.
%
% True if _Term_ or term _Term\theta_ satisfies _Type_.
may_bind_to_type(_, X ) :- var(X), !.
may_bind_to_type(impossible, _) :- instantiation_error(_).
may_bind_to_type(any, _).
may_bind_to_type(atom, X) :- atom(X).
may_bind_to_type(atomic, X) :- atomic(X).
may_bind_to_type(between(L,U), X) :- ( integer(L)
-> integer(X), between(L,U,X)
; number(X), X >= L, X =< U
).
may_bind_to_type(boolean, X) :- (X==true;X==false), !.
may_bind_to_type(callable, X) :- callable(X).
may_bind_to_type(chars, X) :- chars(X).
may_bind_to_type(codes, X) :- codes(X).
may_bind_to_type(text, X) :- text(X).
may_bind_to_type(compound, X) :- compound(X).
may_bind_to_type(constant, X) :- atomic(X).
may_bind_to_type(float, X) :- float(X).
may_bind_to_type(ground, X) :- ground(X).
may_bind_to_type(integer, X) :- integer(X).
may_bind_to_type(nonneg, X) :- integer(X), X >= 0.
may_bind_to_type(positive_integer, X) :- integer(X), X > 0.
may_bind_to_type(negative_integer, X) :- integer(X), X < 0.
may_bind_to_type(predicate_indicator, X) :-
(
X = M:PI
->
may_bind_to_type( atom, M),
may_bind_to_type(predicate_indicator, PI)
;
X = N/A
->
may_bind_to_type( atom, N),
may_bind_to_type(integer, A)
;
X = N//A
->
may_bind_to_type( atom, N),
may_bind_to_type(integer, A)
).
may_bind_to_type(nonvar, _X).
may_bind_to_type(number, X) :- number(X).
may_bind_to_type(oneof(L), X) :- ground(X), lists:memberchk(X, L).
may_bind_to_type(proper_list, X) :- is_list(X).
may_bind_to_type(list, X) :- is_list(X).
may_bind_to_type(list_or_partial_list, X) :- is_list_or_partial_list(X).
may_bind_to_type(symbol, X) :- atom(X).
may_bind_to_type(var, X) :- var(X).
may_bind_to_type(rational, X) :- rational(X).
may_bind_to_type(string, X) :- string(X).
may_bind_to_type(stream, X) :- is_stream(X).
may_bind_to_type(list(Type), X) :- is_list(X), element_types(X, Type).
chars(0) :- !, fail.
chars([]).
chars([H|T]) :-

42
pl/preds.yap
View File

@ -674,7 +674,7 @@ system_predicate(A, P0) :-
/**
@pred current_predicate( _F_) is iso
@pred current_predicate( F ) is iso
True if _F_ is the predicate indicator for a currently defined user or
library predicate.The indicator _F_ is of the form _Mod_:_Na_/_Ar_ or _Na/Ar_,
@ -683,32 +683,34 @@ system_predicate(A, P0) :-
*/
current_predicate(F0) :-
'$yap_strip_module'(F0, M, F),
'$c_i_predicate'( F, M ).
must_bind_to_type( predicate_indicator, F ),
'$c_i_predicate'( F, M ).
'$c_i_predicate'( A/N, M ) :-
!,
( nonvar(A), nonvar(N) ->
functor(S, A, N),
!,
(
ground(A/N)
->
atom(A), integer(N),
functor(S, A, N),
current_predicate(A, M:S)
;
current_predicate(A, M:S),
functor(S, A, N)
).
current_predicate(A, M:S),
functor(S, A, N)
).
'$c_i_predicate'( A//N, M ) :-
!,
( nonvar(A), nonvar(N) ->
N2 is N+2,
functor(S, A, N2),
(
ground(A)
->
atom(A), integer(N),
N2 is N+2,
functor(S, A, N2),
current_predicate(A, M:S)
;
current_predicate(A, M:S),
functor(S, A, N2),
N is N-2
).
'$c_i_predicate'( F, M ) :-
'$do_error'(type_error(predicate_indicator,F),
current_predicate(M:F)).
current_predicate(A, M:S),
functor(S, A, N2),
N is N2-2
).
'$imported_predicate'(A, G, ImportingMod, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),