From 556937195d1588f7e5d058a26e22623ad2291880 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 7 Dec 2012 08:08:32 +0000 Subject: [PATCH] avoid meta-call in system; improve goal/pred expansion --- C/cdmgr.c | 1 + C/exec.c | 113 +++++++++++++++++++++++++++++++++++++++++++++++++ H/iatoms.h | 2 + H/ratoms.h | 2 + H/tatoms.h | 4 ++ misc/ATOMS | 2 + pl/boot.yap | 111 ++++++------------------------------------------ pl/consult.yap | 36 +++++++++------- pl/control.yap | 93 +++++++++++++++++++++++++++++++++++++++- pl/errors.yap | 6 +-- pl/modules.yap | 6 +-- pl/signals.yap | 16 ++++++- 12 files changed, 267 insertions(+), 125 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index 7a81246bc..571044842 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2151,6 +2151,7 @@ goal_expansion_support(PredEntry *p, Term tf) if (p0) { mark_preds_with_this_func(FunctorOfTerm(tg), p0); } else { + CACHE_REGS Term mod = CurrentModule; PredEntry *npe; if (CurrentModule == PROLOG_MODULE) diff --git a/C/exec.c b/C/exec.c index 55558eb91..12be12956 100644 --- a/C/exec.c +++ b/C/exec.c @@ -646,6 +646,117 @@ p_execute_in_mod( USES_REGS1 ) return(do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS)); } +static Int +p_do_goal_expansion( USES_REGS1 ) +{ + Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL; + Int out = FALSE; + PredEntry *pe; + Term cmod = Deref(ARG2); + + ARG2 = ARG3; + /* disable creeping */ + LOCK(LOCAL_SignalLock); + LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + if (!LOCAL_ActiveSignals) + CreepFlag = CalculateStackGap(); + UNLOCK(LOCAL_SignalLock); + + /* CurMod:goal_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + out = TRUE; + ARG3 = ARG2; + goto complete; + } + /* system:goal_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + out = TRUE; + ARG3 = ARG2; + goto complete; + } + ARG3 = ARG2; + ARG2 = cmod; + /* user:goal_expansion(A,CurMod,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + out = TRUE; + goto complete; + } + ARG2 = ARG3; + /* user:goal_expansion(A,B) */ + if ( cmod != USER_MODULE && /* we have tried this before */ + (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + ARG3 = ARG2; + out = TRUE; + } + complete: + LOCK(LOCAL_SignalLock); + if (creeping) { + LOCAL_ActiveSignals |= YAP_CREEP_SIGNAL; + } + UNLOCK(LOCAL_SignalLock); + return out; +} + +static Int +p_do_term_expansion( USES_REGS1 ) +{ + Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL; + Int out = FALSE; + PredEntry *pe; + Term cmod = CurrentModule; + + /* disable creeping */ + LOCK(LOCAL_SignalLock); + LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + if (!LOCAL_ActiveSignals) + CreepFlag = CalculateStackGap(); + UNLOCK(LOCAL_SignalLock); + + /* CurMod:term_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + out = TRUE; + goto complete; + } + /* system:term_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + out = TRUE; + goto complete; + } + /* user:term_expansion(A,B) */ + if ( cmod != USER_MODULE && /* we have tried this before */ + (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) { + out = TRUE; + } + complete: + LOCK(LOCAL_SignalLock); + if (creeping) { + LOCAL_ActiveSignals |= YAP_CREEP_SIGNAL; + } + UNLOCK(LOCAL_SignalLock); + return out; +} + static Int p_execute0( USES_REGS1 ) { /* '$execute0'(Goal,Mod) */ @@ -1838,6 +1949,8 @@ Yap_InitExecFs(void) Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0); Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0); Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0); + Yap_InitCPred("$do_goal_expansion", 3, p_do_goal_expansion, 0); + Yap_InitCPred("$do_term_expansion", 2, p_do_term_expansion, 0); Yap_InitCPred("$get_exception", 1, p_get_exception, 0); } diff --git a/H/iatoms.h b/H/iatoms.h index c437cfa05..46fdc415c 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -289,6 +289,7 @@ AtomSystemLibraryDir = Yap_LookupAtom("system_library_directory"); AtomTerm = Yap_LookupAtom("term"); AtomTerms = Yap_LookupAtom("terms"); + AtomTermExpansion = Yap_LookupAtom("term_expansion"); AtomTextStream = Yap_LookupAtom("text_stream"); AtomThreads = Yap_LookupAtom("threads"); AtomThrow = Yap_LookupAtom("throw"); @@ -424,6 +425,7 @@ FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,4); FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,7); FunctorShortSyntaxError = Yap_MkFunctor(AtomSyntaxError,1); + FunctorTermExpansion = Yap_MkFunctor(AtomTermExpansion,2); FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2); FunctorThrow = Yap_MkFunctor(AtomThrow,1); FunctorTimeoutError = Yap_MkFunctor(AtomTimeoutError,2); diff --git a/H/ratoms.h b/H/ratoms.h index 64e3251b6..6dfabb879 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -289,6 +289,7 @@ AtomSystemLibraryDir = AtomAdjust(AtomSystemLibraryDir); AtomTerm = AtomAdjust(AtomTerm); AtomTerms = AtomAdjust(AtomTerms); + AtomTermExpansion = AtomAdjust(AtomTermExpansion); AtomTextStream = AtomAdjust(AtomTextStream); AtomThreads = AtomAdjust(AtomThreads); AtomThrow = AtomAdjust(AtomThrow); @@ -424,6 +425,7 @@ FunctorStreamPos = FuncAdjust(FunctorStreamPos); FunctorSyntaxError = FuncAdjust(FunctorSyntaxError); FunctorShortSyntaxError = FuncAdjust(FunctorShortSyntaxError); + FunctorTermExpansion = FuncAdjust(FunctorTermExpansion); FunctorThreadRun = FuncAdjust(FunctorThreadRun); FunctorThrow = FuncAdjust(FunctorThrow); FunctorTimeoutError = FuncAdjust(FunctorTimeoutError); diff --git a/H/tatoms.h b/H/tatoms.h index a996ce74d..cf0c4a98f 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -576,6 +576,8 @@ #define AtomTerm Yap_heap_regs->AtomTerm_ Atom AtomTerms_; #define AtomTerms Yap_heap_regs->AtomTerms_ + Atom AtomTermExpansion_; +#define AtomTermExpansion Yap_heap_regs->AtomTermExpansion_ Atom AtomTextStream_; #define AtomTextStream Yap_heap_regs->AtomTextStream_ Atom AtomThreads_; @@ -846,6 +848,8 @@ #define FunctorSyntaxError Yap_heap_regs->FunctorSyntaxError_ Functor FunctorShortSyntaxError_; #define FunctorShortSyntaxError Yap_heap_regs->FunctorShortSyntaxError_ + Functor FunctorTermExpansion_; +#define FunctorTermExpansion Yap_heap_regs->FunctorTermExpansion_ Functor FunctorThreadRun_; #define FunctorThreadRun Yap_heap_regs->FunctorThreadRun_ Functor FunctorThrow_; diff --git a/misc/ATOMS b/misc/ATOMS index 15e8e5ec5..b2ece67cc 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -294,6 +294,7 @@ A SystemError N "system_error" A SystemLibraryDir N "system_library_directory" A Term N "term" A Terms N "terms" +A TermExpansion N "term_expansion" A TextStream N "text_stream" A Threads N "threads" A Throw N "throw" @@ -429,6 +430,7 @@ F StreamEOS EndOfStream 1 F StreamPos StreamPos 4 F SyntaxError SyntaxError 7 F ShortSyntaxError SyntaxError 1 +F TermExpansion TermExpansion 2 F ThreadRun TopThreadGoal 2 F Throw Throw 1 F TimeoutError TimeoutError 2 diff --git a/pl/boot.yap b/pl/boot.yap index 6d0734d22..33f3d4df1 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -434,7 +434,7 @@ true :- true. -> '$assertz_dynamic'(L,G,G0,Mod) ; - catch(nb_getval('$assert_all',on),_,fail) + '$nb_getval'('$assert_all',on,fail) -> functor(H,N,A), '$dynamic'(N/A,Mod), @@ -571,7 +571,7 @@ true :- true. flush_output, fail. '$present_answer'((?-), Answ) :- - nb_getval('$break',BL), + '$nb_getval'('$break',BL,fail), ( BL \= 0 -> format(user_error, '[~p] ',[BL]) ; true ), ( recorded('$print_options','$toplevel'(Opts),_) -> @@ -900,8 +900,8 @@ not(G) :- \+ '$execute'(G). '$call'(G, CP, G0, CurMod) :- ( '$is_expand_goal_or_meta_predicate'(G,CurMod) -> ( - '$notrace'(('$pred_exists'(goal_expansion(G,NG), CurMod), CurMod:goal_expansion(G,NG) ; system:goal_expansion(G,NG) ; user:goal_expansion(G, CurMod, NG) ; user:goal_expansion(G,NG) )) -> - '$call'(NG, CP, G0,CurMod) + '$do_goal_expansion'(G, CurMod, NG) -> + '$call'(NG, CP, G0,CurMod) ; % repeat other code. '$is_metapredicate'(G,CurMod) -> @@ -994,39 +994,6 @@ not(G) :- \+ '$execute'(G). throw(Ball). -/* This is the break predicate, - it saves the importante data about current streams and - debugger state */ - -break :- - nb_getval('$system_mode',SystemMode), - nb_getval('$trace',Trace), - nb_setval('$trace',off), - nb_getval('$debug_jump',Jump), - nb_getval('$debug_run',Run), - '$debug_on'(Debug), - '$debug_on'(false), - nb_getval('$break',BL), NBL is BL+1, - nb_getval('$spy_gn',SPY_GN), - b_getval('$spy_glist',GList), - b_setval('$spy_glist',[]), - nb_setval('$break',NBL), - current_output(OutStream), current_input(InpStream), - format(user_error, '% Break (level ~w)~n', [NBL]), - '$do_live', - !, - set_value('$live','$true'), - b_setval('$spy_glist',GList), - nb_setval('$spy_gn',SPY_GN), - set_input(InpStream), - set_output(OutStream), - '$debug_on'(Debug), - nb_setval('$debug_jump',Jump), - nb_setval('$debug_run',Run), - nb_setval('$trace',Trace), - nb_setval('$break',BL), - nb_setval('$system_mode',SystemMode). - '$silent_bootstrap'(F) :- '$init_globals', nb_setval('$if_level',0), @@ -1150,18 +1117,12 @@ bootstrap(F) :- expand_term(Term,Expanded) :- - '$current_module'(Mod), - ( \+ '$undefined'(term_expansion(_,_), Mod), - '$notrace'(Mod:term_expansion(Term,Expanded)) - ; \+ '$undefined'(term_expansion(_,_), system), - '$notrace'(system:term_expansion(Term,Expanded)) - ; Mod \= user, \+ '$undefined'(term_expansion(_,_), user), - '$notrace'(user:term_expansion(Term,Expanded)) + ( '$do_term_expansion'(Term,Expanded) + -> + true ; '$expand_term_grammar'(Term,Expanded) - ), - !. - + ). % % Grammar Rules expansion @@ -1170,15 +1131,6 @@ expand_term(Term,Expanded) :- '$translate_rule'((A-->B),C), !. '$expand_term_grammar'(A, A). -% -% Arithmetic expansion -% -'$expand_term_arith'(G1, G2) :- - get_value('$c_arith',true), - '$c_arith'(G1, G2), !. -'$expand_term_arith'(G,G). - - % % Arithmetic expansion % @@ -1258,8 +1210,9 @@ catch_ball(Ball, V) :- catch_ball(C, C). '$run_toplevel_hooks' :- - nb_getval('$break',0), - recorded('$toplevel_hooks',H,_), !, + '$nb_getval'('$break', 0, fail), + recorded('$toplevel_hooks',H,_), + H \= fail, !, ( '$oncenotrace'(H) -> true ; true). '$run_toplevel_hooks'. @@ -1268,7 +1221,7 @@ catch_ball(C, C). '$exit_system_mode' :- nb_setval('$system_mode',off), - ( catch(nb_getval('$trace',on),_,fail) -> '$creep' ; true). + ( '$nb_getval'('$trace',on,fail) -> '$creep' ; true). % % just prevent creeping from going on... @@ -1298,20 +1251,6 @@ catch_ball(C, C). '$notrace'(G) :- '$execute'(G). -'$oncenotrace'(G) :- - '$disable_creep', !, - ( - '$execute'(G) - -> - '$creep' - ; - '$creep', - fail - ). -'$oncenotrace'(G) :- - '$execute'(G), !. - - '$run_at_thread_start' :- recorded('$thread_initialization',M:D,_), '$notrace'(M:D), @@ -1319,31 +1258,5 @@ catch_ball(C, C). '$run_at_thread_start'. -nb_getval(GlobalVariable, Val) :- - '$nb_getval'(GlobalVariable, Val, Error), - (var(Error) - -> - true - ; - '$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) -> - nb_getval(GlobalVariable, Val) - ; - '$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val)) - ). - - -b_getval(GlobalVariable, Val) :- - '$nb_getval'(GlobalVariable, Val, Error), - (var(Error) - -> - true - ; - '$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) -> - true - ; - '$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val)) - ). - - diff --git a/pl/consult.yap b/pl/consult.yap index 6d4fd5440..2a8114c86 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -290,26 +290,26 @@ use_module(M,F,Is) :- !. '$reset_if'(OldIfLevel) :- - catch(nb_getval('$if_level',OldIfLevel),_,fail), !, + '$nb_getval'('$if_level', OldIfLevel, fail), !, nb_setval('$if_level',0). '$reset_if'(0) :- nb_setval('$if_level',0). '$get_if'(Level0) :- - catch(nb_getval('$if_level',Level),_,fail), !, + '$nb_getval'('$if_level', Level, fail), !, Level0 = Level. '$get_if'(0). '$into_system_mode'(OldMode) :- - ( catch(nb_getval('$system_mode', OldMode),_,fail) -> true ; OldMode = off), + ( '$nb_getval'('$system_mode', OldMode, fail) -> true ; OldMode = off), ( OldMode == off -> '$enter_system_mode' ; true ). '$ensure_consulting_file'(OldF, Stream) :- - ( catch(nb_getval('$consulting_file',OldF), _, fail) -> true ; OldF = []), + ( '$nb_getval'('$consulting_file',OldF, fail) -> true ; OldF = []), '$set_consulting_file'(Stream). '$ensure_consulting'(Old, New) :- - ( catch(nb_getval('$consulting',Old), _, fail) -> true ; Old = false ), + ( '$nb_getval'('$consulting',Old, fail) -> true ; Old = false ), nb_setval('$consulting', New). '$bind_module'(_, load_files). @@ -409,12 +409,12 @@ initialization(G,OPT) :- '$exec_initialisation_goals' :- '$show_consult_level'(Level), '$current_module'(M), - findall( - G, - (recorded('$initialisation',do(Level,G),R), erase(R), G\='$'), + recorded('$initialisation',do(Level,_),_), + findall(G, + '$fetch_init_goal'(Level, G), LGs), lists:member(G,LGs), - nb_getval('$system_mode', OldMode), + '$nb_getval'('$system_mode', OldMode, fail), ( OldMode == on -> '$exit_system_mode' ; true ), % run initialization under user control (so allow debugging this stuff). ( @@ -428,6 +428,12 @@ initialization(G,OPT) :- '$exec_initialisation_goals' :- nb_setval('$initialization_goals',off). + +'$fetch_init_goal'(Level, G) :- + recorded('$initialisation',do(Level,G),R), + erase(R), + G\='$'. + '$include'(V, _) :- var(V), !, '$do_error'(instantiation_error,include(V)). '$include'([], _) :- !. @@ -437,7 +443,7 @@ initialization(G,OPT) :- '$include'(X, Status) :- get_value('$lf_verbose',Verbosity), '$full_filename'(X,Y,include(X)), - ( catch( nb_getval('$included_file',OY), _, fail ) -> true ; OY = [] ), + ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), nb_setval('$included_file', Y), '$current_module'(Mod), H0 is heapused, '$cputime'(T0,_), @@ -489,13 +495,13 @@ source_file(Mod:Pred, FileName) :- '$owner_file'(T, Mod, FileName). prolog_load_context(_, _) :- - nb_getval('$consulting_file',[]), !, fail. + '$nb_getval'('$consulting_file', [], fail), !, fail. prolog_load_context(directory, DirName) :- getcwd(DirName). prolog_load_context(file, FileName) :- - ( catch( nb_getval('$included_file',IncFileName), _, fail ) -> true ; IncFileName = [] ), + ( '$nb_getval'('$included_file', IncFileName, fail ) -> true ; IncFileName = [] ), ( IncFileName = [] -> - nb_getval('$consulting_file',FileName), + '$nb_getval'('$consulting_file', FileName, fail), FileName \= [] ; FileName = IncFileName @@ -1008,7 +1014,7 @@ absolute_file_name(File,Opts,TrueFileName) :- '$set_yap_flags'(11,0). '$fetch_comp_status'(assert_all) :- - catch(nb_getval('$assert_all',on), _, fail), !. + '$nb_getval'('$assert_all',on, fail), !. '$fetch_comp_status'(source) :- '$access_yap_flags'(11,1). '$fetch_comp_status'(compact). @@ -1051,7 +1057,7 @@ make_library_index(_Directory). ). '$current_loop_stream'(Stream) :- - catch(nb_getval('$loop_stream',Stream), _, fail). + '$nb_getval'('$loop_stream',Stream, fail). exists_source(File) :- '$full_filename'(File, AbsFile, exists_source(File)). diff --git a/pl/control.yap b/pl/control.yap index 7cf715847..52c1a081d 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -145,7 +145,7 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :- '$clean_call'(_, _). '$cc_check_throw' :- - nb_getval('$catch',Ball), + '$nb_getval'('$catch', Ball, fail), throw(Ball). %%% The unknown predicate, @@ -289,6 +289,97 @@ version(T) :- fail. '$set_toplevel_hook'(_). +'$oncenotrace'(G) :- + '$disable_creep', !, + ( + '$execute'(G) + -> + '$creep' + ; + '$creep', + fail + ). +'$oncenotrace'(G) :- + '$execute'(G), !. + + +'$once0'(G, M) :- + '$pred_exists'(G, M), + ( + '$disable_creep' + -> + ( + '$execute_nonstop'(G, M) + -> + '$creep' + ; + '$creep', + fail + ) + ; + '$execute_nonstop'(G,M) + ). + +nb_getval(GlobalVariable, Val) :- + '$nb_getval'(GlobalVariable, Val, Error), + (var(Error) + -> + true + ; + '$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) -> + nb_getval(GlobalVariable, Val) + ; + '$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val)) + ). + + +b_getval(GlobalVariable, Val) :- + '$nb_getval'(GlobalVariable, Val, Error), + (var(Error) + -> + true + ; + '$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) -> + true + ; + '$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val)) + ). + + +/* This is the break predicate, + it saves the importante data about current streams and + debugger state */ + +break :- + nb_getval('$system_mode',SystemMode), + nb_getval('$trace',Trace), + nb_setval('$trace',off), + nb_getval('$debug_jump',Jump), + nb_getval('$debug_run',Run), + '$debug_on'(Debug), + '$debug_on'(false), + nb_getval('$break',BL), NBL is BL+1, + nb_getval('$spy_gn',SPY_GN), + b_getval('$spy_glist',GList), + b_setval('$spy_glist',[]), + nb_setval('$break',NBL), + current_output(OutStream), current_input(InpStream), + format(user_error, '% Break (level ~w)~n', [NBL]), + '$do_live', + !, + set_value('$live','$true'), + b_setval('$spy_glist',GList), + nb_setval('$spy_gn',SPY_GN), + set_input(InpStream), + set_output(OutStream), + '$debug_on'(Debug), + nb_setval('$debug_jump',Jump), + nb_setval('$debug_run',Run), + nb_setval('$trace',Trace), + nb_setval('$break',BL), + nb_setval('$system_mode',SystemMode). + + at_halt(G) :- recorda('$halt', G, _), fail. diff --git a/pl/errors.yap b/pl/errors.yap index fa55adaa5..478fd425e 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -248,7 +248,7 @@ print_message(Severity, Term) :- % first step at hook processing '$message_to_lines'(Term, Lines), ( nonvar(Term), - '$oncenotrace'(user:message_hook(Term, Severity, Lines)) + '$once0'(message_hook(Term, Severity, Lines), user) -> true ; @@ -263,9 +263,9 @@ print_message(_, Term) :- format(user_error,'~q~n',[Term]). '$message_to_lines'(Term, Lines) :- - '$oncenotrace'(user:generate_message_hook(Term, [], Lines)), !. + '$once0'(generate_message_hook(Term, [], Lines), user), !. '$message_to_lines'(Term, Lines) :- - '$oncenotrace'(prolog:message(Term, Lines, [])), !. + '$once0'(message(Term, Lines, []), prolog), !. '$message_to_lines'(Term, Lines) :- '$messages':generate_message(Term, Lines, []), !. diff --git a/pl/modules.yap b/pl/modules.yap index 37e0c4ea9..80fe28dd9 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -396,11 +396,7 @@ expand_goal(G, G). % make built-in processing transparent. '$match_mod'(G, M, ORIG, HM, G1), '$c_built_in'(G1, M, Gi), - (Gi \== G1 -> - '$module_expansion'(Gi, G2, _, M, CM, HM, HVars) - ; - G2 = G1 - ). + G1 = G2. '$complete_goal_expansion'(G, GMod, _, HM, NG, NG, _) :- '$match_mod'(G, GMod, GMod, HM, NG). diff --git a/pl/signals.yap b/pl/signals.yap index cd7eb7612..5a7e08912 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -36,7 +36,7 @@ '$do_signal'(sig_creep, [M|G]) :- '$creep_allowed', !, ( - ( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ) + ( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ) -> ( '$execute_nonstop'(G0,M), @@ -50,7 +50,7 @@ ). % '$do_signal'(sig_creep, [M|G]) :- - ( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ), + ( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ), !, ( '$execute_nonstop'(G0,M), @@ -168,6 +168,18 @@ '$creep', fail ). +'$start_creep'([M0|'$once0'(G)]) :- + !, + ('$execute_nonstop'(G,M0), + CP1 is '$last_choice_pt', + % exit port: creep + '$creep', + ! + ; + % put it back again on fail + '$creep', + fail + ). % do not debug if we are not in debug mode. '$start_creep'([Mod|G]) :- '$debug_on'(DBON), DBON = false, !,