don't try to do module expansion if module borders are not crossed.
expand on-line depth_call and once. improve write_x_loc git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@752 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
1369dfa410
commit
f5dad3ac1f
29
C/absmi.c
29
C/absmi.c
@ -5396,10 +5396,10 @@ Yap_absmi(int inp)
|
|||||||
Op(write_x_loc, x);
|
Op(write_x_loc, x);
|
||||||
BEGD(d0);
|
BEGD(d0);
|
||||||
d0 = XREG(PREG->u.x.x);
|
d0 = XREG(PREG->u.x.x);
|
||||||
|
PREG = NEXTOP(PREG, x);
|
||||||
deref_head(d0, w_x_unk);
|
deref_head(d0, w_x_unk);
|
||||||
w_x_bound:
|
w_x_bound:
|
||||||
*SREG++ = d0;
|
*SREG++ = d0;
|
||||||
PREG = NEXTOP(PREG, x);
|
|
||||||
GONext();
|
GONext();
|
||||||
|
|
||||||
BEGP(pt0);
|
BEGP(pt0);
|
||||||
@ -5409,7 +5409,6 @@ Yap_absmi(int inp)
|
|||||||
#else
|
#else
|
||||||
if (pt0 > H) {
|
if (pt0 > H) {
|
||||||
#endif
|
#endif
|
||||||
PREG = NEXTOP(PREG, x);
|
|
||||||
/* local variable: let us bind it to the list */
|
/* local variable: let us bind it to the list */
|
||||||
#ifdef FROZEN_STACKS /* TRAIL */
|
#ifdef FROZEN_STACKS /* TRAIL */
|
||||||
Bind_Local(pt0, Unsigned(SREG));
|
Bind_Local(pt0, Unsigned(SREG));
|
||||||
@ -5422,7 +5421,6 @@ Yap_absmi(int inp)
|
|||||||
GONext();
|
GONext();
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
PREG = NEXTOP(PREG, x);
|
|
||||||
*SREG++ = Unsigned(pt0);
|
*SREG++ = Unsigned(pt0);
|
||||||
GONext();
|
GONext();
|
||||||
}
|
}
|
||||||
@ -11801,8 +11799,8 @@ Yap_absmi(int inp)
|
|||||||
goto execute_metacall;
|
goto execute_metacall;
|
||||||
ENDP(pt1);
|
ENDP(pt1);
|
||||||
ENDD(d1);
|
ENDD(d1);
|
||||||
} else {
|
} else if (mod != CurrentModule) {
|
||||||
goto execute_metacall;
|
goto execute_metacall;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (PRED_GOAL_EXPANSION_ON) {
|
if (PRED_GOAL_EXPANSION_ON) {
|
||||||
@ -11990,7 +11988,12 @@ Yap_absmi(int inp)
|
|||||||
goto execute_comma;
|
goto execute_comma;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
goto execute_metacall_after_comma;
|
if (mod != CurrentModule)
|
||||||
|
goto execute_metacall_after_comma;
|
||||||
|
else {
|
||||||
|
arity = pen->ArityOfPE;
|
||||||
|
goto execute_comma;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
BEGP(pt1);
|
BEGP(pt1);
|
||||||
@ -12004,12 +12007,14 @@ Yap_absmi(int inp)
|
|||||||
ENDP(pt1);
|
ENDP(pt1);
|
||||||
ENDD(d1);
|
ENDD(d1);
|
||||||
} else {
|
} else {
|
||||||
execute_metacall_after_comma:
|
if (mod != CurrentModule) {
|
||||||
ARG1 = ARG3 = d0;
|
execute_metacall_after_comma:
|
||||||
pen = PredMetaCall;
|
ARG1 = ARG3 = d0;
|
||||||
ARG2 = Yap_cp_as_integer((choiceptr)ENV[E_CB]);
|
pen = PredMetaCall;
|
||||||
ARG4 = ModuleName[mod];
|
ARG2 = Yap_cp_as_integer((choiceptr)ENV[E_CB]);
|
||||||
goto execute_after_comma;
|
ARG4 = ModuleName[mod];
|
||||||
|
goto execute_after_comma;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
execute_comma:
|
execute_comma:
|
||||||
|
@ -51,10 +51,29 @@ static Int p_set_depth_limit(void)
|
|||||||
return(TRUE);
|
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)
|
void Yap_InitItDeepenPreds(void)
|
||||||
{
|
{
|
||||||
Yap_InitCPred("get_depth_limit", 1, p_get_depth_limit, SafePredFlag);
|
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", 1, p_set_depth_limit, 0);
|
||||||
|
Yap_InitCPred("$set_depth_limit_for_next_call", 1, p_set_depth_limit_for_next_call, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
10
C/exec.c
10
C/exec.c
@ -262,7 +262,7 @@ do_execute(Term t, SMALLUNSGN mod)
|
|||||||
YENV[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
|
YENV[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
return CallMetaCall(mod);
|
return CallMetaCall(mod);
|
||||||
}
|
}
|
||||||
YENV[E_CP] = (CELL)P;
|
YENV[E_CP] = (CELL)P;
|
||||||
YENV[E_CB] = (CELL)B;
|
YENV[E_CB] = (CELL)B;
|
||||||
@ -277,9 +277,10 @@ do_execute(Term t, SMALLUNSGN mod)
|
|||||||
P = NEXTOP(COMMA_CODE,sla);
|
P = NEXTOP(COMMA_CODE,sla);
|
||||||
t = ArgOfTerm(1,t);
|
t = ArgOfTerm(1,t);
|
||||||
goto restart_exec;
|
goto restart_exec;
|
||||||
}
|
} else if (mod != CurrentModule) {
|
||||||
return(CallMetaCall(mod));
|
return(CallMetaCall(mod));
|
||||||
}
|
}
|
||||||
|
}
|
||||||
/* now let us do what we wanted to do from the beginning !! */
|
/* now let us do what we wanted to do from the beginning !! */
|
||||||
/* I cannot use the standard macro here because
|
/* I cannot use the standard macro here because
|
||||||
otherwise I would dereference the argument and
|
otherwise I would dereference the argument and
|
||||||
@ -384,7 +385,8 @@ p_execute_within(void)
|
|||||||
goto restart_exec;
|
goto restart_exec;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return(CallMetaCallWithin(mod, B));
|
if (mod != CurrentModule)
|
||||||
|
return(CallMetaCallWithin(mod, B));
|
||||||
}
|
}
|
||||||
/* at this point check if we should enter creep mode */
|
/* at this point check if we should enter creep mode */
|
||||||
if (yap_flags[SPY_CREEP_FLAG]) {
|
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", 11, p_execute_9, 0);
|
||||||
Yap_InitCPred("$call_with_args", 12, p_execute_10, 0);
|
Yap_InitCPred("$call_with_args", 12, p_execute_10, 0);
|
||||||
#ifdef DEPTH_LIMIT
|
#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
|
#endif
|
||||||
Yap_InitCPred("$execute0", 2, p_execute0, 0);
|
Yap_InitCPred("$execute0", 2, p_execute0, 0);
|
||||||
Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
|
Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
|
||||||
|
@ -14,10 +14,6 @@
|
|||||||
* comments: Prolog's scanner *
|
* comments: Prolog's scanner *
|
||||||
* *
|
* *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
#ifdef SCCS
|
|
||||||
static char SccsId[] = "@(#)scanner.c 1.2";
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Description:
|
* Description:
|
||||||
|
54
pl/arith.yap
54
pl/arith.yap
@ -30,24 +30,40 @@ compile_expressions :- '$set_value'('$c_arith',true).
|
|||||||
|
|
||||||
do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
||||||
|
|
||||||
'$c_built_in'(IN, OUT) :-
|
'$c_built_in'(IN, M, OUT) :-
|
||||||
'$get_value'('$c_arith',true), !,
|
'$get_value'('$c_arith',true), !,
|
||||||
'$do_c_built_in'(IN, OUT).
|
'$do_c_built_in'(IN, M, OUT).
|
||||||
'$c_built_in'(IN, IN).
|
'$c_built_in'(IN, _, IN).
|
||||||
|
|
||||||
|
|
||||||
'$do_c_built_in'(Mod:G, Mod:GN) :- !,
|
'$do_c_built_in'(G, M, OUT) :- var(G), !,
|
||||||
'$do_c_built_in'(G, GN).
|
'$do_c_built_in'(call(M:G),M,OUT).
|
||||||
'$do_c_built_in'(\+ G, 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),
|
nonvar(G),
|
||||||
G = (A = B),
|
G = (A = B),
|
||||||
!,
|
!,
|
||||||
OUT = (A \= B).
|
OUT = (A \= B).
|
||||||
'$do_c_built_in'(call(G), OUT) :-
|
'$do_c_built_in'(call(G), _, OUT) :-
|
||||||
nonvar(G),
|
nonvar(G),
|
||||||
G = (Mod:G1), !,
|
G = (Mod:G1), !,
|
||||||
'$do_c_built_metacall'(G1, Mod, OUT).
|
'$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),
|
nonvar(K),
|
||||||
!,
|
!,
|
||||||
( '$db_key'(K,I) ->
|
( '$db_key'(K,I) ->
|
||||||
@ -55,7 +71,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
|||||||
;
|
;
|
||||||
OUT = recorded(K,T,R)
|
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
|
nonvar(Y), % Don't rewrite variables
|
||||||
!,
|
!,
|
||||||
(
|
(
|
||||||
@ -65,7 +81,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
|||||||
'$drop_is'(X0, X, P1),
|
'$drop_is'(X0, X, P1),
|
||||||
'$do_and'(P0, P1, P)
|
'$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'(Comp0, Op, E, F),
|
||||||
!,
|
!,
|
||||||
'$compop'(Comp, Op, U, V),
|
'$compop'(Comp, Op, U, V),
|
||||||
@ -73,7 +89,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
|||||||
'$expand_expr'(F, Q, V),
|
'$expand_expr'(F, Q, V),
|
||||||
'$do_and'(P, Q, R0),
|
'$do_and'(P, Q, R0),
|
||||||
'$do_and'(R0, Comp, R).
|
'$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)) :-
|
'$do_c_built_metacall'(G1, Mod, call(Mod:G1)) :-
|
||||||
var(G1), var(Mod), !.
|
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).
|
||||||
'$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:
|
% expanding an expression:
|
||||||
% first argument is the expression not expanded,
|
% first argument is the expression not expanded,
|
||||||
% second argument the expanded expression
|
% second argument the expanded expression
|
||||||
|
@ -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).
|
'|'(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'(\+(G),prolog).
|
||||||
\+(G) :- '$meta_call'(not(G),prolog).
|
not(G) :- '$meta_call'(not(G),prolog).
|
||||||
|
|
||||||
:- '$set_value'('$doindex',true).
|
:- '$set_value'('$doindex',true).
|
||||||
|
|
||||||
|
@ -419,9 +419,9 @@ module(N) :-
|
|||||||
'$pred_goal_expansion_on',
|
'$pred_goal_expansion_on',
|
||||||
user:goal_expansion(G,M,GI), !,
|
user:goal_expansion(G,M,GI), !,
|
||||||
'$module_expansion'(GI,G1,G2,M,CM,TM,HVars).
|
'$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), !,
|
'$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, Mod, _, Mod, G, G, _) :- !.
|
||||||
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).
|
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user