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

style check fixes

Browse Source 
improve error message on redefining system predicate


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@252 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-01-02 16:55:24 +00:00
parent 666bb88a7e
commit 3962e559aa
11 changed files with 62 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
C/cdmgr.c
View File

@ -778,7 +778,7 @@ not_was_reconsulted(PredEntry *p, Term t, int mode)
}
static void
addcl_permission_error(AtomEntry *ap, Int Arity)
addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
{
Term t, ti[2];
@ -788,16 +788,29 @@ addcl_permission_error(AtomEntry *ap, Int Arity)
ErrorMessage = ErrorSay;
Error_Term = t;
Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
if (Arity == 0)
sprintf(ErrorMessage, "static predicate %s is in use", ap->StrOfAE);
else
sprintf(ErrorMessage,
if (in_use) {
if (Arity == 0)
sprintf(ErrorMessage, "static predicate %s is in use", ap->StrOfAE);
else
sprintf(ErrorMessage,
#if SHORT_INTS
"static predicate %s/%ld is in use",
"static predicate %s/%ld is in use",
#else
"static predicate %s/%d is in use",
"static predicate %s/%d is in use",
#endif
ap->StrOfAE, Arity);
ap->StrOfAE, Arity);
} else {
if (Arity == 0)
sprintf(ErrorMessage, "system predicate %s", ap->StrOfAE);
else
sprintf(ErrorMessage,
#if SHORT_INTS
"system predicate %s/%ld",
#else
"system predicate %s/%d",
#endif
ap->StrOfAE, Arity);
}
}
@ -830,7 +843,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
/* we are redefining a prolog module predicate */
if (p->ModuleOfPred == 0 && mod != 0) {
WRITE_UNLOCK(p->PRWLock);
addcl_permission_error(RepAtom(at), Arity);
addcl_permission_error(RepAtom(at), Arity, FALSE);
return;
}
/* The only problem we have now is when we need to throw away
@ -840,7 +853,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
if (!RemoveIndexation(p)) {
/* should never happen */
WRITE_UNLOCK(p->PRWLock);
addcl_permission_error(RepAtom(at),Arity);
addcl_permission_error(RepAtom(at),Arity,TRUE);
return;
}
}

2
C/dbase.c
View File

@ -4089,7 +4089,7 @@ p_first_age(void)
/* given an integer, and a reference to the fist element, find the
corresponding reference, if one exists. */
/* $db_nb_to_ref(+Age,+Key,-Ref) */
/* $db_nb_to_ref(+Age,+Key,+M,-Ref) */
static Int
p_db_nb_to_ref(void)
{

31
pl/boot.yap
View File

@ -210,8 +210,8 @@ repeat :- '$repeat'.
%
% Hack in case expand_term has created a list of commands.
%
'$execute_commands'(V,VL,Con) :- var(V), !,
throw(error(instantiation_error,meta_call(C))).
'$execute_commands'(V,_,_) :- var(V), !,
throw(error(instantiation_error,meta_call(V))).
'$execute_commands'([],_,_) :- !, fail.
'$execute_commands'([C|_],VL,Con) :-
'$execute_command'(C,VL,Con).
@ -275,14 +275,14 @@ repeat :- '$repeat'.
%
'$process_directive'(D, _, M) :-
'$access_yap_flags'(8, 1), !, % ISO Prolog mode, go in and do it,
throw(error(context_error((:- D),query),directive)).
throw(error(context_error((:- M:D),query),directive)).
%
% but YAP and SICStus does.
%
'$process_directive'(G, _, M) :-
( '$do_yes_no'(G,M) -> true ; '$format'(user_error,":- ~w:~w failed.~n",[M,G]) ).
'$all_directives'(M:G1) :- !,
'$all_directives'(_:G1) :- !,
'$all_directives'(G1).
'$all_directives'((G1,G2)) :- !,
'$all_directives'(G1),
@ -376,13 +376,13 @@ repeat :- '$repeat'.
'$erase_mf_source'(Na, Ar, M) :-
'$get_value'('$consulting_file',F),
'$recorded'('$multifile'(_,_,_), '$mf'(Na,A,M,F,R), R1),
'$recorded'('$multifile'(_,_,_), '$mf'(Na,Ar,M,F,R), R1),
erase(R1),
erase(R),
fail.
'$erase_mf_source'(Na, A, M) :-
'$erase_mf_source'(Na, Ar, M) :-
'$get_value'('$consulting_file',F),
'$recorded'('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
'$recorded'('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,M,F,R), R1),
erase(R1),
erase(R),
fail.
@ -406,7 +406,7 @@ repeat :- '$repeat'.
/* Executing a query */
'$query'(end_of_file,V).
'$query'(end_of_file,_).
% ***************************
% * -------- YAPOR -------- *
@ -598,7 +598,7 @@ repeat :- '$repeat'.
'$name_vars_in_goals1'(NGVL, I, IF).
'$name_vars_in_goals1'([NV|NGVL], I0, IF) :-
nonvar(NV),
'$name_vars_in_goals1'(NGVL, II, IF).
'$name_vars_in_goals1'(NGVL, I0, IF).
'$write_output_vars'([]).
'$write_output_vars'([V|VL]) :-
@ -748,9 +748,9 @@ not(A) :-
'$execute_within'(B,CP,G0,M)
).
'$spied_call'(\+ X,_,_,M) :- !,
\+ '$execute'(X).
'$spied_call'(not X,_,_,_) :- !,
\+ '$execute'(X).
\+ '$execute'(M:X).
'$spied_call'(not X,_,_,M) :- !,
\+ '$execute'(M:X).
'$spied_call'(!,CP,_,_) :-
'$$cut_by'(CP).
'$spied_call'([A|B],_,_,M) :- !,
@ -1229,7 +1229,7 @@ catch(G,C,A) :-
'$system_catch_call'(X,G,I,NX),
( X = NX -> !, '$erase_catch_elements'(I) ; true).
% someone sent us a throw.
'$system_catch'(_,C,A,_,M0) :-
'$system_catch'(_,C,A,_,M) :-
array_element('$catch_queue', 1, X), X \= '$',
update_array('$catch_queue', 1, '$'),
array_element('$catch_queue', 0, catch(_,Lev,Q)), !,
@ -1237,8 +1237,7 @@ catch(G,C,A) :-
'$db_clean_queues'(Lev),
'$erase_catch_elements'(Lev),
( C=X ->
(A = M:G -> '$execute'(A) ;
'$current_module'(_,M0), '$execute'(M0:A) )
'$execute'(M:A)
;
throw(X)
).
@ -1252,7 +1251,7 @@ catch(G,C,A) :-
'$erase_catch_elements'(OldCatch, I, Catch),
update_array('$catch_queue', 0, Catch).
'$erase_catch_elements'(catch(X, J, P), I, Catch) :-
'$erase_catch_elements'(catch(_, J, P), I, Catch) :-
J >= I, !,
'$erase_catch_elements'(P, I, Catch).
'$erase_catch_elements'(Catch, _, Catch).

5
pl/checker.yap
View File

@ -66,12 +66,12 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$check_term'(T,_) :-
'$get_value'('$syntaxcheckdiscontiguous',on),
'$current_module'(M),
'$xtract_head'(T,M,NM,H,F,A),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_discontiguous'(F,A,NM), fail.
'$check_term'(T,_) :-
'$get_value'('$syntaxcheckmultiple',on),
'$current_module'(M),
'$xtract_head'(T,M,NM,H,F,A),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_multiple'(F,A,NM), fail.
'$check_term'(T,VL) :-
'$get_value'('$syntaxchecksinglevar',on),
@ -121,6 +121,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
write(user_error,') ]'),
nl(user_error).
'$xtract_head'(V,M,M,V,call,1) :- var(V), !.
'$xtract_head'((H:-_),OM,M,NH,Name,Arity) :- !,
'$xtract_head'(H,OM,M,NH,Name,Arity).
'$xtract_head'((H,_),OM,M,H1,Name,Arity) :- !,

2
pl/corout.yap
View File

@ -381,7 +381,7 @@ when(_,Goal) :-
%
'$block'(Conds) :-
'$generate_blocking_code'(Conds, _, Code),
'$current_module'(Mod),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
'$block'(_).

6
pl/debug.yap
View File

@ -281,7 +281,7 @@ debugging :-
'$get_value'(debug,1), /* ditto if debug off */
'$get_value'(spy_fs,0), /* ditto if fast skipping */
( '$access_yap_flags'(10,0) -> /* if not creeping ... */
'$pred_being_spied'(G,M) /* ... spy only if at a spy-point */
'$pred_being_spied'(G,Module) /* ... spy only if at a spy-point */
; true
),
% ( \+ '$undefined'(user_error_spy(_), user) -> user_error_spy(G) ;
@ -536,7 +536,7 @@ debugging :-
('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)),
CP is '$last_choice_pt',
(
'$db_nb_to_ref'(Cl,M:G,Mod,Ref),
'$db_nb_to_ref'(Cl,M:G,Ref),
instance(Ref, (G :- Clause)),
(Clause = true -> true ; '$debug_catch_call'(Clause,M,CP) )
;
@ -714,7 +714,7 @@ debugging :-
'$direct_spy'([Module|'!'(CP)]),
% clean up any garbage left here by the debugger.
'$$cut_by'(CP).
'$creep_call'('$cut_by'(X),Module,_) :- !,
'$creep_call'('$cut_by'(X),_,_) :- !,
'$$cut_by'(X).
'$creep_call'(repeat,Module,_) :- !,
'$direct_spy'([Module|repeat]).

2
pl/directives.yap
View File

@ -67,7 +67,7 @@
op(P,OPSEC,OP).
'$exec_directive'(set_prolog_flag(F,V), _, _) :-
set_prolog_flag(F,V).
'$exec_directive'(ensure_loaded(F), _, M) :-
'$exec_directive'(ensure_loaded(F), _, _) :-
'$ensure_loaded'(F).
'$exec_directive'(char_conversion(IN,OUT), _, _) :-
char_conversion(IN,OUT).

12
pl/preds.yap
View File

@ -237,7 +237,7 @@ clause(V,Q) :-
throw(error(instantiation_error,M:clause(V,Q))).
'$clause'(C,M,Q) :- number(C), !,
throw(error(type_error(callable,C),M:clause(C,Q))).
'$clause'(R,Q) :- db_reference(R), !,
'$clause'(R,M,Q) :- db_reference(R), !,
throw(error(type_error(callable,R),M:clause(R,Q))).
'$clause'(M:P,_,Q) :- !,
'$clause'(P,M,Q).
@ -262,7 +262,7 @@ clause(V,Q,R) :-
'$clause'(C,M,Q,R) :- number(C), !,
throw(error(type_error(callable,C),clause(C,M:Q,R))).
'$clause'(R,M,Q,R1) :- db_reference(R), !,
throw(error(type_error(callable,R),clause(R,Q,R1))).
throw(error(type_error(callable,R),clause(R,M:Q,R1))).
'$clause'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R).
'$clause'(P,Mod,Q,R) :-
@ -353,9 +353,8 @@ abolish(N,A) :-
throw(error(instantiation_error,abolish(M:N,A))).
'$abolish'(N,A,M) :- var(A), !,
throw(error(instantiation_error,abolish(M:N,A))).
throw(error(instantiation_error,abolish(M:N,A))).
'$abolish'(N,A,M) :-
( '$recorded'('$predicate_defs','$predicate_defs'(N,A,_),R) -> erase(R) ),
( '$recorded'('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
fail.
'$abolish'(N,A,M) :- functor(T,N,A),
( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
@ -467,7 +466,7 @@ abolish(X) :-
'$abolishs'(G, M) :- '$in_use'(G, M), !,
functor(G,Name,Arity),
throw(error(permission_error(modify,static_procedure_in_use,Name/Arity),abolish(M:G))).
'$abolishs'(G, _) :- '$system_predicate'(G), !,
'$abolishs'(G, M) :- '$system_predicate'(G), !,
functor(G,Name,Arity),
throw(error(permission_error(modify,static_procedure,Name/Arity),abolish(M:G))).
'$abolishs'(G, Module) :-
@ -496,7 +495,7 @@ dynamic(X) :- '$access_yap_flags'(8, 0), !,
dynamic(X) :-
throw(error(context_error(dynamic(X),declaration),query)).
'$dynamic'(X,_) :- var(X), !,
'$dynamic'(X,M) :- var(X), !,
throw(error(instantiation_error,dynamic(M:X))).
'$dynamic'(Mod:Spec,_) :- !,
'$dynamic'(Spec,Mod).
@ -565,6 +564,7 @@ dynamic_predicate(P,Sem) :-
'$public'([],_) :- !.
'$public'([H|L], M) :- !, '$public'(H, M), '$public'(L, M).
'$public'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N),
'$do_make_public'(T, Mod).
'$public'(X, Mod) :-
throw(error(type_error(callable,X),dynamic(Mod:X))).

10
pl/tabling.yap
View File

@ -53,9 +53,7 @@ show_trie(X) :-
'$show_trie'(X, M).
'$show_trie'(X, M) :- var(X), !,
write(user_error, '[ Error: argument to trie/1 should be a predicate ]'),
nl(user_error),
fail.
throw(error(instantiation_error,show_trie(M:X))).
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M).
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M).
'$show_trie'(A/N, M) :- integer(N), atom(A), !,
@ -70,7 +68,7 @@ show_trie(X) :-
fail
).
'$show_trie'(X, M) :- write(user_error, '[ Error: '),
write(user_error, X),
write(user_error, M:X),
write(user_error, ' is an invalid argument to trie/1 ]'),
nl(user_error),
fail.
@ -79,7 +77,7 @@ abolish_trie(X) :-
'$current_module'(M),
'$abolish_trie'(X, M).
'$abolish_trie'(X, M) :- var(X), !,
'$abolish_trie'(X, _M) :- var(X), !,
write(user_error, '[ Error: argument to abolish_trie/1 should be a predicate ]'),
nl(user_error),
fail.
@ -97,7 +95,7 @@ abolish_trie(X) :-
fail
).
'$abolish_trie'(X,M) :- write(user_error, '[ Error: '),
write(user_error, X),
write(user_error, M:X),
write(user_error, ' is an invalid argument to abolish_trie/1 ]'),
nl(user_error),
fail.

6
pl/utils.yap
View File

@ -123,6 +123,7 @@ call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9))).
@ -296,7 +297,8 @@ current_predicate(A,M:T) :- % module specified
'$current_predicate_no_modules'(M,A,T).
current_predicate(A,M:T) :- % module specified
nonvar(T),
!,
!,
functor(T,A,_),
'$pred_exists'(T,M).
current_predicate(A,M:T) :- % module specified
!,
@ -510,7 +512,7 @@ predicate_property(Pred,Prop) :-
'$predicate_property'(Pred,Mod,Prop),
'$pred_exists'(Pred,Mod).
'$predicate_property'(P,M,built_in) :-
'$predicate_property'(P,_,built_in) :-
'$system_predicate'(P), !.
'$predicate_property'(P,M,dynamic) :-
'$is_dynamic'(P,M).

4
pl/yapor.yap
View File

@ -70,9 +70,7 @@ default_sequential(_).
fail.
'$parallel_directive'(X,M) :- var(X), !,
write(user_error, '[ Error: argument to parallel/1 should be a predicate ]'),
nl(user_error),
fail.
throw(error(instantiation_error,parallel(M:X))).
'$parallel_directive'((A,B),M) :- !,
'$parallel_directive'(A,M),
'parallel_directive'(B,M).