more fixes to modules
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2102 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
6cc240fe7f
commit
e748bd9b33
@ -218,14 +218,17 @@ init_current_module(void)
|
|||||||
static Int
|
static Int
|
||||||
p_strip_module(void)
|
p_strip_module(void)
|
||||||
{
|
{
|
||||||
Term t1 = Deref(ARG1), t2, tmod;
|
Term t1 = Deref(ARG1), t2, tmod = CurrentModule;
|
||||||
|
if (tmod == PROLOG_MODULE) {
|
||||||
|
tmod = TermProlog;
|
||||||
|
}
|
||||||
if (IsVarTerm(t1) ||
|
if (IsVarTerm(t1) ||
|
||||||
!IsApplTerm(t1) ||
|
!IsApplTerm(t1) ||
|
||||||
FunctorOfTerm(t1) != FunctorModule ||
|
FunctorOfTerm(t1) != FunctorModule ||
|
||||||
IsVarTerm(t2 = ArgOfTerm(1,t1)) ||
|
IsVarTerm(t2 = ArgOfTerm(1,t1)) ||
|
||||||
!IsAtomTerm(t2)) {
|
!IsAtomTerm(t2)) {
|
||||||
return Yap_unify(ARG3, t1) &&
|
return Yap_unify(ARG3, t1) &&
|
||||||
Yap_unify(ARG2, CurrentModule);
|
Yap_unify(ARG2, tmod);
|
||||||
}
|
}
|
||||||
do {
|
do {
|
||||||
tmod = t2;
|
tmod = t2;
|
||||||
|
2
C/save.c
2
C/save.c
@ -1007,8 +1007,10 @@ get_coded(int flag, OPCODE old_ops[])
|
|||||||
static void
|
static void
|
||||||
restore_heap_regs(void)
|
restore_heap_regs(void)
|
||||||
{
|
{
|
||||||
|
if (HeapTop) {
|
||||||
HeapTop = AddrAdjust(HeapTop);
|
HeapTop = AddrAdjust(HeapTop);
|
||||||
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
|
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
|
||||||
|
}
|
||||||
HeapMax = Yap_heap_regs->heap_used = OldHeapUsed;
|
HeapMax = Yap_heap_regs->heap_used = OldHeapUsed;
|
||||||
restore_codes();
|
restore_codes();
|
||||||
}
|
}
|
||||||
|
@ -11,8 +11,12 @@
|
|||||||
* File: stdpreds.c *
|
* File: stdpreds.c *
|
||||||
* comments: General-purpose C implemented system predicates *
|
* comments: General-purpose C implemented system predicates *
|
||||||
* *
|
* *
|
||||||
* Last rev: $Date: 2008-02-13 10:15:35 $,$Author: vsc $ *
|
* Last rev: $Date: 2008-02-15 12:41:33 $,$Author: vsc $ *
|
||||||
* $Log: not supported by cvs2svn $
|
* $Log: not supported by cvs2svn $
|
||||||
|
* Revision 1.127 2008/02/13 10:15:35 vsc
|
||||||
|
* fix some bugs from yesterday plus improve support for modules in
|
||||||
|
* operators.
|
||||||
|
*
|
||||||
* Revision 1.126 2008/02/07 23:09:13 vsc
|
* Revision 1.126 2008/02/07 23:09:13 vsc
|
||||||
* don't break ISO standard in current_predicate/1.
|
* don't break ISO standard in current_predicate/1.
|
||||||
* Include Nicos flag.
|
* Include Nicos flag.
|
||||||
@ -2881,7 +2885,7 @@ init_current_op(void)
|
|||||||
EXTRA_CBACK_ARG(4,1) = (CELL) MkAtomTerm(a);
|
EXTRA_CBACK_ARG(4,1) = (CELL) MkAtomTerm(a);
|
||||||
EXTRA_CBACK_ARG(4,2) = (CELL) MkIntTerm(i);
|
EXTRA_CBACK_ARG(4,2) = (CELL) MkIntTerm(i);
|
||||||
if (IsVarTerm(top))
|
if (IsVarTerm(top))
|
||||||
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(3);
|
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(0);
|
||||||
else if (IsAtomTerm(top))
|
else if (IsAtomTerm(top))
|
||||||
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(4);
|
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(4);
|
||||||
else
|
else
|
||||||
|
22
pl/utils.yap
22
pl/utils.yap
@ -296,17 +296,23 @@ op(P,T,V) :-
|
|||||||
'$check_op_names'(As, G).
|
'$check_op_names'(As, G).
|
||||||
|
|
||||||
|
|
||||||
|
'$op'(P, T, [A|As]) :- !,
|
||||||
|
'$opl'(P, T, [A|As]).
|
||||||
'$op'(P, T, A) :-
|
'$op'(P, T, A) :-
|
||||||
|
'$op2'(P,T,A).
|
||||||
|
|
||||||
|
'$opl'(P, T, []).
|
||||||
|
'$opl'(P, T, [A|As]) :-
|
||||||
|
'$op2'(P, T, A),
|
||||||
|
'$opl'(P, T, As).
|
||||||
|
|
||||||
|
'$op2'(P,T,A) :-
|
||||||
atom(A), !,
|
atom(A), !,
|
||||||
'$opdec'(P,T,A,prolog).
|
'$opdec'(P,T,A,prolog).
|
||||||
'$op'(P, T, user:A) :- !,
|
'$op2'(P,T,A) :-
|
||||||
'$opdec'(P,T,A,prolog).
|
strip_module(A,M,N),
|
||||||
'$op'(P, T, M:A) :-
|
(M = user -> NM = prolog ; NM = M),
|
||||||
'$opdec'(P,T,A,M).
|
'$opdec'(P,T,N,NM).
|
||||||
'$op'(_, _, []).
|
|
||||||
'$op'(P, T, [A|As]) :-
|
|
||||||
'$op'(P, T, A),
|
|
||||||
'$op'(P, T, As).
|
|
||||||
|
|
||||||
current_op(X,Y,V) :- var(V), !,
|
current_op(X,Y,V) :- var(V), !,
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
|
Reference in New Issue
Block a user