diff --git a/C/absmi.c b/C/absmi.c index f304edfe4..1ac585655 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -5396,10 +5396,10 @@ Yap_absmi(int inp) Op(write_x_loc, x); BEGD(d0); d0 = XREG(PREG->u.x.x); + PREG = NEXTOP(PREG, x); deref_head(d0, w_x_unk); w_x_bound: *SREG++ = d0; - PREG = NEXTOP(PREG, x); GONext(); BEGP(pt0); @@ -5409,7 +5409,6 @@ Yap_absmi(int inp) #else if (pt0 > H) { #endif - PREG = NEXTOP(PREG, x); /* local variable: let us bind it to the list */ #ifdef FROZEN_STACKS /* TRAIL */ Bind_Local(pt0, Unsigned(SREG)); @@ -5422,7 +5421,6 @@ Yap_absmi(int inp) GONext(); } else { - PREG = NEXTOP(PREG, x); *SREG++ = Unsigned(pt0); GONext(); } @@ -11801,8 +11799,8 @@ Yap_absmi(int inp) goto execute_metacall; ENDP(pt1); ENDD(d1); - } else { - goto execute_metacall; + } else if (mod != CurrentModule) { + goto execute_metacall; } } if (PRED_GOAL_EXPANSION_ON) { @@ -11990,7 +11988,12 @@ Yap_absmi(int inp) goto execute_comma; } } else { - goto execute_metacall_after_comma; + if (mod != CurrentModule) + goto execute_metacall_after_comma; + else { + arity = pen->ArityOfPE; + goto execute_comma; + } } BEGP(pt1); @@ -12004,12 +12007,14 @@ Yap_absmi(int inp) ENDP(pt1); ENDD(d1); } else { - execute_metacall_after_comma: - ARG1 = ARG3 = d0; - pen = PredMetaCall; - ARG2 = Yap_cp_as_integer((choiceptr)ENV[E_CB]); - ARG4 = ModuleName[mod]; - goto execute_after_comma; + if (mod != CurrentModule) { + execute_metacall_after_comma: + ARG1 = ARG3 = d0; + pen = PredMetaCall; + ARG2 = Yap_cp_as_integer((choiceptr)ENV[E_CB]); + ARG4 = ModuleName[mod]; + goto execute_after_comma; + } } } execute_comma: diff --git a/C/depth_bound.c b/C/depth_bound.c index e325baf41..606ca0552 100644 --- a/C/depth_bound.c +++ b/C/depth_bound.c @@ -51,10 +51,29 @@ static Int p_set_depth_limit(void) return(TRUE); } +static Int p_set_depth_limit_for_next_call(void) +{ + Term d = Deref(ARG1); + + if (IsVarTerm(d)) { + Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit"); + return(FALSE); + } else if (!IsIntegerTerm(d)) { + Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit"); + return(FALSE); + } + d = MkIntTerm(IntegerOfTerm(d)*2); + + DEPTH = d; + + return(TRUE); +} + void Yap_InitItDeepenPreds(void) { Yap_InitCPred("get_depth_limit", 1, p_get_depth_limit, SafePredFlag); Yap_InitCPred("$set_depth_limit", 1, p_set_depth_limit, 0); + Yap_InitCPred("$set_depth_limit_for_next_call", 1, p_set_depth_limit_for_next_call, 0); } #endif diff --git a/C/exec.c b/C/exec.c index 0eadcd3cb..ecd35defb 100644 --- a/C/exec.c +++ b/C/exec.c @@ -262,7 +262,7 @@ do_execute(Term t, SMALLUNSGN mod) YENV[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod)); } } else { - return CallMetaCall(mod); + return CallMetaCall(mod); } YENV[E_CP] = (CELL)P; YENV[E_CB] = (CELL)B; @@ -277,9 +277,10 @@ do_execute(Term t, SMALLUNSGN mod) P = NEXTOP(COMMA_CODE,sla); t = ArgOfTerm(1,t); goto restart_exec; - } + } else if (mod != CurrentModule) { return(CallMetaCall(mod)); } + } /* now let us do what we wanted to do from the beginning !! */ /* I cannot use the standard macro here because otherwise I would dereference the argument and @@ -384,7 +385,8 @@ p_execute_within(void) goto restart_exec; } } - return(CallMetaCallWithin(mod, B)); + if (mod != CurrentModule) + return(CallMetaCallWithin(mod, B)); } /* at this point check if we should enter creep mode */ if (yap_flags[SPY_CREEP_FLAG]) { @@ -1733,7 +1735,7 @@ Yap_InitExecFs(void) Yap_InitCPred("$call_with_args", 11, p_execute_9, 0); Yap_InitCPred("$call_with_args", 12, p_execute_10, 0); #ifdef DEPTH_LIMIT - Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0); + Yap_InitCPred("depth_bound_call", 2, p_execute_depth_limit, 0); #endif Yap_InitCPred("$execute0", 2, p_execute0, 0); Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, 0); diff --git a/C/scanner.c b/C/scanner.c index 761c30a84..de838f2d3 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -14,10 +14,6 @@ * comments: Prolog's scanner * * * *************************************************************************/ -#ifdef SCCS -static char SccsId[] = "@(#)scanner.c 1.2"; - -#endif /* * Description: diff --git a/pl/arith.yap b/pl/arith.yap index 0db2ec343..9ad782773 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -30,24 +30,40 @@ compile_expressions :- '$set_value'('$c_arith',true). do_not_compile_expressions :- '$set_value'('$c_arith',[]). -'$c_built_in'(IN, OUT) :- +'$c_built_in'(IN, M, OUT) :- '$get_value'('$c_arith',true), !, - '$do_c_built_in'(IN, OUT). -'$c_built_in'(IN, IN). + '$do_c_built_in'(IN, M, OUT). +'$c_built_in'(IN, _, IN). -'$do_c_built_in'(Mod:G, Mod:GN) :- !, - '$do_c_built_in'(G, GN). -'$do_c_built_in'(\+ G, OUT) :- +'$do_c_built_in'(G, M, OUT) :- var(G), !, + '$do_c_built_in'(call(M:G),M,OUT). +'$do_c_built_in'(Mod:G, _, GN) :- !, + '$do_c_built_in'(G, Mod, GN0), + (GN0 = (_,_) -> GN = GN0 ; GN = Mod:GN0). +'$do_c_built_in'(\+ G, _, OUT) :- nonvar(G), G = (A = B), !, OUT = (A \= B). -'$do_c_built_in'(call(G), OUT) :- +'$do_c_built_in'(call(G), _, OUT) :- nonvar(G), G = (Mod:G1), !, '$do_c_built_metacall'(G1, Mod, OUT). -'$do_c_built_in'(recorded(K,T,R), OUT) :- +'$do_c_built_in'(call(G), M, OUT) :- + var(G), !, + '$do_c_built_metacall'(G, M, OUT). +'$do_c_built_in'(depth_bound_call(G,D), M, OUT) :- !, + '$do_c_built_in'(G, M, NG), + % make sure we don't have something like (A,B) -> $depth_next(D), A, B. + ( '$composed_built_in'(NG) -> + OUT = depth_bound_call(NG,D) + ; + OUT = ('$set_depth_limit_for_next_call'(D),NG) + ). +'$do_c_built_in'(once(G), M, ('$save_current_choice_point'(CP),NG,'$$cut_by'(CP))) :- !, + '$do_c_built_in'(G,M,NG). +'$do_c_built_in'(recorded(K,T,R), _, OUT) :- nonvar(K), !, ( '$db_key'(K,I) -> @@ -55,7 +71,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]). ; OUT = recorded(K,T,R) ). -'$do_c_built_in'(X is Y, P) :- +'$do_c_built_in'(X is Y, _, P) :- nonvar(Y), % Don't rewrite variables !, ( @@ -65,7 +81,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]). '$drop_is'(X0, X, P1), '$do_and'(P0, P1, P) ). -'$do_c_built_in'(Comp0, R) :- % now, do it for comparisons +'$do_c_built_in'(Comp0, _, R) :- % now, do it for comparisons '$compop'(Comp0, Op, E, F), !, '$compop'(Comp, Op, U, V), @@ -73,7 +89,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]). '$expand_expr'(F, Q, V), '$do_and'(P, Q, R0), '$do_and'(R0, Comp, R). -'$do_c_built_in'(P, P). +'$do_c_built_in'(P, _, P). '$do_c_built_metacall'(G1, Mod, call(Mod:G1)) :- var(G1), var(Mod), !. @@ -106,7 +122,21 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]). '$compop'(X=:=Y,=:=, X, Y). '$compop'(X=\=Y,=\=, X, Y). - +'$composed_built_in'(V) :- var(V), !, + fail. +'$composed_built_in'(('$save_current_choice_point'(_),NG,'$$cut_by'(_))) :- !, + '$composed_built_in'(NG). +'$composed_built_in'((_,_)). +'$composed_built_in'((_;_)). +'$composed_built_in'((_|_)). +'$composed_built_in'((_->_)). +'$composed_built_in'(_:G) :- + '$composed_built_in'(G). +'$composed_built_in'(\+G) :- + '$composed_built_in'(G). +'$composed_built_in'(not(G)) :- + '$composed_built_in'(G). + % expanding an expression: % first argument is the expression not expanded, % second argument the expanded expression diff --git a/pl/init.yap b/pl/init.yap index 9077d0860..fc141a7c4 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -31,8 +31,8 @@ false :- fail. ';'(A,B) :- '$meta_call'((A;B),prolog). '|'(A,B) :- '$meta_call'((A;B),prolog). '->'(A,B) :- '$meta_call'((A->B),prolog). -\+(G) :- '$meta_call'('\+'(G),prolog). -\+(G) :- '$meta_call'(not(G),prolog). +\+(G) :- '$meta_call'(\+(G),prolog). +not(G) :- '$meta_call'(not(G),prolog). :- '$set_value'('$doindex',true). diff --git a/pl/modules.yap b/pl/modules.yap index bc2523f86..f04ba4c41 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -419,9 +419,9 @@ module(N) :- '$pred_goal_expansion_on', user:goal_expansion(G,M,GI), !, '$module_expansion'(GI,G1,G2,M,CM,TM,HVars). -'$complete_goal_expansion'(G, _, _, M, G, GF, _) :- +'$complete_goal_expansion'(G, M, _, _, G, GF, _) :- '$system_predicate'(G,M), !, - '$c_built_in'(G,GF). + '$c_built_in'(G,M,GF). '$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !. '$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).