diff --git a/C/cdmgr.c b/C/cdmgr.c index b64956a41..42b4e9572 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2568,6 +2568,43 @@ p_cut_transparent(void) return(TRUE); } +static Int /* $is_push_pred_mod(P,M) */ +p_is_push_pred_mod(void) +{ + PredEntry *pe; + + Term t1 = Deref(ARG1); + restart_system_pred: + if (IsVarTerm(t1)) + return (FALSE); + if (IsAtomTerm(t1)) { + pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), 0)); + } else if (IsApplTerm(t1)) { + Functor funt = FunctorOfTerm(t1); + if (IsExtensionFunctor(funt)) { + return(FALSE); + } + if (funt == FunctorModule) { + Term nmod = ArgOfTerm(1, t1); + if (IsVarTerm(nmod)) { + Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1"); + return(FALSE); + } + if (!IsAtomTerm(nmod)) { + Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1"); + return(FALSE); + } + t1 = ArgOfTerm(2, t1); + goto restart_system_pred; + } + pe = RepPredProp(GetPredPropByFunc(funt, 0)); + } else + return (FALSE); + if (EndOfPAEntr(pe)) + return(FALSE); + return(pe->PredFlags & CutTransparentPredFlag); +} + void InitCdMgr(void) @@ -2613,5 +2650,6 @@ InitCdMgr(void) InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag); InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag); InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag); + InitCPred("$is_push_pred_mod", 2, p_is_push_pred_mod, SyncPredFlag); } diff --git a/pl/debug.yap b/pl/debug.yap index 86f96df89..90a184d15 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -257,25 +257,32 @@ debugging :- '$spy'([_|Mod:G]) :- !, '$spy'([Mod|G]). '$spy'([Module|'$call'(G)]) :- !, - 'fetch_goal_module'(G, Module, G1, Mod), + '$fetch_goal_module'(G, Module, G1, Mod), '$expand_goal'(G1, Mod, Module, NG, NM), /* we may execute a system predicate, so we cannot jump straight to do_spy */ '$spy'([NM|NG]). '$spy'([Module|G]) :- % '$format'(user_error,"$spym(~w,~w)~n",[Module,G]), - '$hidden_predicate'(G,Module), + '$hidden_predicate'(G,Module), !, /* called from prolog module */ '$execute0'(G,Module), '$creep'. +'$spy'([Module|G]) :- +% '$format'(user_error,"$spym(~w,~w)~n",[Module,G]), + '$is_push_pred_mod'(G,Module), + !, + /* called from prolog module */ + '$creep', + '$execute0'(G,Module). '$spy'([Mod|G]) :- '$do_spy'(G,Mod). -'fetch_goal_module'(V, M, V, M) :- var(V), !. -'fetch_goal_module'(M:G, _, NG, Mod) :- !, - 'fetch_goal_module'(G, M, NG, Mod). -'fetch_goal_module'(G, M, G, M). +'$fetch_goal_module'(V, M, V, M) :- var(V), !. +'$fetch_goal_module'(M:G, _, NG, Mod) :- !, + '$fetch_goal_module'(G, M, NG, Mod). +'$fetch_goal_module'(G, M, G, M). '$direct_spy'(G) :- diff --git a/pl/errors.yap b/pl/errors.yap index 4e43813da..59c3745f7 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -179,6 +179,8 @@ print_message(Level, Mss) :- '$preprocess_stack'(Gs, NGs). '$beautify_hidden_goal'('$do_spy',_,prolog,ClNo,Gs,NGs) :- !, '$preprocess_stack'(Gs, NGs). +'$beautify_hidden_goal'('$spy',_,prolog,ClNo,Gs,NGs) :- !, + '$preprocess_stack'(Gs, NGs). '$beautify_hidden_goal'('$do_creep_execute',_,prolog,ClNo,Gs,NGs) :- !, '$preprocess_stack'(Gs, NGs). '$beautify_hidden_goal'('$creep_execute',_,prolog,ClNo,Gs,NGs) :- !, diff --git a/pl/modules.yap b/pl/modules.yap index 4c83161c9..93bde5461 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -331,6 +331,7 @@ module(N) :- '$expand_goal2'(G, ExportingMod, NG, NM). '$expand_goal2'(G, M, GF, M) :- '$pred_goal_expansion_on', + % make sure we do not try to expand conjs, etc... user:goal_expansion(G,M,GF), !. '$expand_goal2'(G, M, G, M).