Fix regression on handling system preds.
Algorithm - fix system modules - fix system predicates - hide atoms with $
This commit is contained in:
parent
a32ac66167
commit
23d18ac0fd
@ -16,25 +16,36 @@
|
|||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
:- system_module( '$_protect', [], ['$protect'/0]).
|
:- system_module( '$_protect', [], ['$protect'/0]).
|
||||||
|
/**
|
||||||
|
* @file protect.yap
|
||||||
|
* @addgroup ProtectCore Freeze System Configuration
|
||||||
|
* @ingroup CoreUtilities
|
||||||
|
*
|
||||||
|
* This protects current code from further changes
|
||||||
|
* and also makes it impossible for some predicates to be seen
|
||||||
|
* in user-space.
|
||||||
|
*
|
||||||
|
* Algorithm:
|
||||||
|
* - fix system modules
|
||||||
|
* - fix system predicates
|
||||||
|
* - hide atoms with `$`
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
% This protects all code from further changes
|
|
||||||
% and also makes it impossible from some predicates to be seen
|
|
||||||
'$protect' :-
|
'$protect' :-
|
||||||
'$current_predicate'(Name,prolog,P,_),
|
'$all_current_modules'(M),
|
||||||
M \= user,
|
( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ),
|
||||||
|
new_system_module( M ),
|
||||||
|
fail.
|
||||||
|
'$protect' :-
|
||||||
|
'$current_predicate'(Name,M,P,_),
|
||||||
|
'$is_system_module'(M),
|
||||||
functor(P,Name,Arity),
|
functor(P,Name,Arity),
|
||||||
'$new_system_predicate'(Name,Arity,M),
|
'$new_system_predicate'(Name,Arity,M),
|
||||||
sub_atom(Name,0,1,_, '$'),
|
sub_atom(Name,0,1,_, '$'),
|
||||||
functor(P,Name,Arity),
|
functor(P,Name,Arity),
|
||||||
'$hide_predicate'(P,M),
|
'$hide_predicate'(P,M),
|
||||||
fail.
|
fail.
|
||||||
'$protect' :-
|
|
||||||
'$system_module'(M),
|
|
||||||
'$current_predicate'(Name,M,P,_),
|
|
||||||
M \= user,
|
|
||||||
functor(P,Name,Arity),
|
|
||||||
'$new_system_predicate'(Name,Arity,M),
|
|
||||||
fail.
|
|
||||||
'$protect' :-
|
'$protect' :-
|
||||||
current_atom(Name),
|
current_atom(Name),
|
||||||
sub_atom(Name,0,1,_, '$'),
|
sub_atom(Name,0,1,_, '$'),
|
||||||
|
Reference in New Issue
Block a user