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:
vsc 2008-02-15 12:41:33 +00:00
parent 6cc240fe7f
commit e748bd9b33
4 changed files with 30 additions and 15 deletions

View File

@ -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;

View File

@ -1007,8 +1007,10 @@ get_coded(int flag, OPCODE old_ops[])
static void static void
restore_heap_regs(void) restore_heap_regs(void)
{ {
HeapTop = AddrAdjust(HeapTop); if (HeapTop) {
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag; HeapTop = AddrAdjust(HeapTop);
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
}
HeapMax = Yap_heap_regs->heap_used = OldHeapUsed; HeapMax = Yap_heap_regs->heap_used = OldHeapUsed;
restore_codes(); restore_codes();
} }

View File

@ -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.
@ -2827,7 +2831,7 @@ cont_current_op(void)
tmod = pp->OpModule; tmod = pp->OpModule;
READ_UNLOCK(pp->OpRWLock); READ_UNLOCK(pp->OpRWLock);
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(fix); EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(fix);
return (Yap_unify_constant(ARG1, MkIntTerm(prio)) && return (Yap_unify_constant(ARG1, MkIntTerm(prio)) &&
Yap_unify_constant(ARG2, TType) && Yap_unify_constant(ARG2, TType) &&
Yap_unify_constant(ARG3, MkAtomTerm(a)) && Yap_unify_constant(ARG3, MkAtomTerm(a)) &&
Yap_unify_constant(ARG4, tmod)); Yap_unify_constant(ARG4, tmod));
@ -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

View File

@ -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),