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

this is hard

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-07-31 10:41:54 -05:00
parent 2fef5ffcea
commit bb4820a086
1 changed files with 37 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
pl/preds.yap
View File

@ -603,7 +603,7 @@ current_predicate(A,T0) :-
(
'$current_predicate'(A,M, T, user)
;
'$imported_predicate'(T, M, T1, M1),
'$imported_predicate'(A, T, M, T1, M1),
\+ '$is_system_predicate'(T1,M1)
).
@ -683,50 +683,38 @@ system_predicate(A, P0) :-
*/
current_predicate(F0) :-
'$yap_strip_module'(F0, M, F),
(var(F) ->
F = A/N,
'$c_i_predicate'( F, M ).
'$c_i_predicate'( A/N, M ) :-
!,
( nonvar(A), nonvar(N) ->
functor(S, A, N),
current_predicate(A, M:S)
;
current_predicate(A, M:S),
functor(S, A, N)
;
(
functor(F,AN,2)
->
true
;
'$do_error'(type_error(predicate_indicator,F0),
current_predicate(F0))
),
arg(1,F,A),
(atom(A) -> true ;
var(A) -> true ;
'$do_error'(type_error(predicate_indicator,F0),current_predicate(F0))
),
arg(2,F,N),
(integer(N) -> true ;
var(N) -> true ;
'$do_error'(type_error(predicate_indicator,F0),current_predicate(F0))
),
( AN == '/'
->
current_predicate(A, M:S),
functor( S, A, N)
;
AN == '//'
->
current_predicate(A, M:S),
Ar2 is N+2,
functor( S, A, Ar2)
;
'$do_error'(type_error(predicate_indicator,F0),current_predicate(F0))
)
).
'$c_i_predicate'( A//N, M ) :-
!,
( nonvar(A), nonvar(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)).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
'$imported_predicate'(A, G, ImportingMod, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
functor(G, A, Arity),
'$pred_exists'(G, ExportingMod),
'$predicate_flags'(G0, ExportingMod, Flags, Flags).
'$pred_exists'(G0, ExportingMod),
'$predicate_flags'(G0, ExportingMod, Flags, Flags),
functor(G, A, _Arity).
/** @pred current_key(? _A_,? _K_)
@ -816,6 +804,13 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :-
functor(P, N, Ar),
'$set_flag'(P, M, Flag, V).
%% '$set_flag'(P, M, trace, off) :-
% set a predicate flag
%
'$set_flag'(P, M, trace, off) :-
'$predicate_flags'(P,M,F,F),
FN is F \/ 0x400000000,
'$predicate_flags'(P,M,F,FN).
/**
@}