Try to clarify operators

prolog has priority and cannot be redefined by default.
user is global but may be redefined
others should just plug-in.
This commit is contained in:
Vítor Santos Costa 2016-02-26 17:18:37 +00:00
parent a448e25d8d
commit c25d35356a
6 changed files with 142 additions and 216 deletions

View File

@ -562,60 +562,60 @@ Yap_OpPropForModule(Atom a,
return info;
}
OpEntry *
Yap_GetOpProp(Atom a,
op_type type
USES_REGS) { /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *oinfo = NULL;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
static OpEntry *
fetchOpWithModule( PropEntry *pp, Term tmod, op_type type )
{
while (!EndOfPAEntr(pp)) {
OpEntry *info = NULL;
if (pp->KindOfPE != OpProperty) {
pp = RepProp(pp->NextOfPE);
continue;
}
info = (OpEntry *)pp;
if (info->OpModule != CurrentModule && info->OpModule != PROLOG_MODULE) {
if (info->OpModule != tmod) {
pp = RepProp(pp->NextOfPE);
continue;
}
if (type == INFIX_OP) {
if (!info->Infix) {
pp = RepProp(pp->NextOfPE);
continue;
return NULL;
}
} else if (type == POSFIX_OP) {
if (!info->Posfix) {
pp = RepProp(pp->NextOfPE);
continue;
return NULL;
}
} else {
if (!info->Prefix) {
pp = RepProp(pp->NextOfPE);
continue;
return NULL;
}
}
/* if it is not the latest module */
if (info->OpModule == PROLOG_MODULE) {
/* cannot commit now */
oinfo = info;
pp = RepProp(pp->NextOfPE);
} else {
READ_LOCK(info->OpRWLock);
READ_UNLOCK(ae->ARWLock);
return info;
}
}
if (oinfo) {
READ_LOCK(oinfo->OpRWLock);
return NULL;
}
OpEntry *
Yap_GetOpProp(Atom a,
op_type type,
Term tmod
USES_REGS) { /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *info;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
if (( (info = fetchOpWithModule( pp, tmod, type )) != NULL) ||
( (info = fetchOpWithModule( pp, USER_MODULE, type )) != NULL) ||
( (info = fetchOpWithModule( pp, PROLOG_MODULE, type )) != NULL)
) {
LOCK(info->OpRWLock);
return info;
READ_UNLOCK(ae->ARWLock);
return oinfo;
}
READ_UNLOCK(ae->ARWLock);
return NULL;
}

View File

@ -52,6 +52,7 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
n->KindOfPE = ModProperty;
n->PredForME = NULL;
n->NextME = CurrentModules;
n->ParentForME = CurrentModule;
CurrentModules = n;
n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
@ -259,7 +260,6 @@ static Int change_module(USES_REGS1) { /* $change_module(N) */
Term mod = Deref(ARG1);
LookupModule(mod);
CurrentModule = mod;
LOCAL_SourceModule = mod;
return TRUE;
}

View File

@ -164,9 +164,9 @@ typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *, Term CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *, Term CACHE_TYPE);
const char *Yap_tokRep(TokEntry *tokptr);
@ -367,16 +367,12 @@ Term Yap_Variables(VarEntry *p, Term l) {
return Variables(p, l PASS_REGS);
}
static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) {
static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS);
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, tmod PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Prefix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = p &MaskPrio;
@ -389,21 +385,17 @@ static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) {
}
}
int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod) {
CACHE_REGS
return IsPrefixOp(op, pptr, rpptr PASS_REGS);
return IsPrefixOp(op, pptr, rpptr, tmod PASS_REGS);
}
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) {
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS);
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, tmod PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Infix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = *lpptr = p &MaskPrio;
@ -418,21 +410,17 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) {
}
}
int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod) {
CACHE_REGS
return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS);
return IsInfixOp(op, pptr, lpptr, rpptr, tmod PASS_REGS);
}
static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) {
static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS);
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, tmod PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Posfix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *lpptr = p &MaskPrio;
@ -445,9 +433,9 @@ static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) {
}
}
int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod) {
CACHE_REGS
return IsPosfixOp(op, pptr, lpptr PASS_REGS);
return IsPosfixOp(op, pptr, lpptr, tmod PASS_REGS);
}
inline static void GNextToken(USES_REGS1) {
@ -472,9 +460,9 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
#ifdef O_QUASIQUOTATIONS
static int is_quasi_quotation_syntax(Term goal, Atom *pat) {
static int is_quasi_quotation_syntax(Term goal, Term m, Atom *pat) {
CACHE_REGS
Term m = CurrentModule, t;
Term t;
Atom at;
UInt arity;
Functor f;
@ -525,7 +513,7 @@ static int get_quasi_quotation(term_t t, unsigned char **here,
#endif /*O_QUASIQUOTATIONS*/
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
Term arg1 USES_REGS) {
Term arg1, Term tmod USES_REGS) {
int nargs = 0;
Term *p, t;
Functor func;
@ -562,7 +550,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
*tp++ = Unsigned(ParseTerm(999, FailBuff PASS_REGS));
*tp++ = Unsigned(ParseTerm(999, FailBuff, tmod PASS_REGS));
ParserAuxSp = (char *)tp;
++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
@ -617,14 +605,14 @@ static Term MakeAccessor(Term t, Functor f USES_REGS) {
return Yap_MkApplTerm(f, 2, tf);
}
static Term ParseList(JMPBUFF *FailBuff USES_REGS) {
static Term ParseList(JMPBUFF *FailBuff, Term tmod USES_REGS) {
Term o;
CELL *to_store;
o = AbsPair(HR);
loop:
to_store = HR;
HR += 2;
to_store[0] = ParseTerm(999, FailBuff PASS_REGS);
to_store[0] = ParseTerm(999, FailBuff, tmod PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken;
@ -641,7 +629,7 @@ loop:
}
} else if (((int)LOCAL_tokptr->TokInfo) == '|') {
NextToken;
to_store[1] = ParseTerm(999, FailBuff PASS_REGS);
to_store[1] = ParseTerm(999, FailBuff, tmod PASS_REGS);
} else {
to_store[1] = MkAtomTerm(AtomNil);
}
@ -653,7 +641,7 @@ loop:
return (o);
}
static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
/* parse term with priority prio */
Volatile Term t;
Volatile Functor func;
@ -686,7 +674,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
}
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)) {
IsPrefixOp((Atom)t, &opprio, &oprprio, tmod PASS_REGS)) {
if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo;
#ifndef _MSC_VER
@ -721,7 +709,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
t = ParseTerm(oprprio, FailBuff PASS_REGS);
t = ParseTerm(oprprio, FailBuff, tmod PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -733,7 +721,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom)t, ')', FailBuff, 0L PASS_REGS);
t = ParseArgs((Atom)t, ')', FailBuff, 0L, tmod PASS_REGS);
else
t = MkAtomTerm((Atom)t);
break;
@ -749,7 +737,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_CharsToTDQ(p, CurrentModule, LOCAL_encoding PASS_REGS);
t = Yap_CharsToTDQ(p, tmod, LOCAL_encoding PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL;
@ -764,7 +752,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
t = Yap_WCharsToTDQ(p, tmod PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \'%S\'",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo);
FAIL;
@ -780,7 +768,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_CharsToTBQ(p, CurrentModule, LOCAL_encoding PASS_REGS);
t = Yap_CharsToTBQ(p, tmod, LOCAL_encoding PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \'%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL;
@ -792,7 +780,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
case WBQString_tok: /* build list on the heap */
{
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS);
t = Yap_WCharsToTBQ(p, tmod PASS_REGS);
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -822,7 +810,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
case '(':
case 'l': /* non solo ( */
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS);
checkfor(')', FailBuff PASS_REGS);
break;
case '[':
@ -833,7 +821,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
NextToken;
break;
}
t = ParseList(FailBuff PASS_REGS);
t = ParseList(FailBuff, tmod PASS_REGS);
checkfor(']', FailBuff PASS_REGS);
break;
case '{':
@ -844,7 +832,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
NextToken;
break;
}
t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -896,7 +884,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
}
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS);
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
syntax_msg("expected to find quasi quotes, got \"%s\"", ,
Yap_tokRep(LOCAL_tokptr));
@ -954,7 +942,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) &&
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, tmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */
Volatile int oldprio = curprio;
@ -967,7 +955,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
{
Term args[2];
args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff PASS_REGS);
args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS);
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -979,7 +967,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
opinfo = save_opinfo; continue;, opinfo = save_opinfo;
curprio = oldprio;)
}
if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio &&
if (IsPosfixOp(opinfo, &opprio, &oplprio , tmod PASS_REGS) && opprio <= prio &&
oplprio >= curprio) {
/* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
@ -1005,7 +993,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(1000, FailBuff PASS_REGS);
args[1] = ParseTerm(1000, FailBuff, tmod PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -1015,12 +1003,12 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
curprio = 1000;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, tmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff PASS_REGS);
args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -1030,24 +1018,24 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, tmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t PASS_REGS);
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, tmod PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&oplprio PASS_REGS) &&
&oplprio, tmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS);
t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, tmod PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&oplprio PASS_REGS) &&
&oplprio, tmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS);
t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, tmod PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
curprio = opprio;
continue;
@ -1062,7 +1050,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
return t;
}
Term Yap_Parse(UInt prio) {
Term Yap_Parse(UInt prio, Term tmod) {
CACHE_REGS
Volatile Term t;
JMPBUFF FailBuff;
@ -1070,7 +1058,7 @@ Term Yap_Parse(UInt prio) {
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff PASS_REGS);
t = ParseTerm(prio, &FailBuff, tmod PASS_REGS);
#if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPutc(stderr, '[');
@ -1083,7 +1071,8 @@ Term Yap_Parse(UInt prio) {
}
#endif
Yap_CloseSlots(sls);
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
if (LOCAL_Error_TYPE == YAP_NO_ERROR &&
LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_ErrorMessage = "term does not end on . ";
t = 0;

View File

@ -984,24 +984,27 @@ int Yap_IsOpMaxPrio(Atom at) {
return max;
}
static Int unify_op(OpEntry *op USES_REGS) {
static bool unify_op(OpEntry *op, Term emod USES_REGS) {
Term tmod = op->OpModule;
if (tmod == PROLOG_MODULE)
tmod = TermProlog;
return Yap_unify_constant(ARG2, tmod) &&
Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
if (tmod != PROLOG_MODULE &&
tmod != USER_MODULE &&
tmod != emod &&
(op->Prefix || op->Infix || op->Posfix))
return false;
return Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
Yap_unify_constant(ARG4, MkIntegerTerm(op->Infix)) &&
Yap_unify_constant(ARG5, MkIntegerTerm(op->Posfix));
}
static Int cont_current_op(USES_REGS1) {
OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next;
Term emod = Deref(ARG2);
READ_LOCK(op->OpRWLock);
next = op->OpNext;
if (Yap_unify_constant(ARG1, MkAtomTerm(op->OpName)) &&
unify_op(op PASS_REGS)) {
unify_op(op, emod PASS_REGS)) {
READ_UNLOCK(op->OpRWLock);
if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
@ -1014,7 +1017,6 @@ static Int cont_current_op(USES_REGS1) {
READ_UNLOCK(op->OpRWLock);
if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
B->cp_h = HR;
return FALSE;
} else {
cut_fail();
@ -1034,7 +1036,7 @@ static Int cont_current_atom_op(USES_REGS1) {
READ_LOCK(op->OpRWLock);
next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS);
if (unify_op(op PASS_REGS)) {
if (unify_op(op, CurrentModule PASS_REGS)) {
READ_UNLOCK(op->OpRWLock);
if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);

View File

@ -1007,7 +1007,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
return;
}
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp, CurrentModule)) {
Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
@ -1035,7 +1035,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets ||
atom == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp)) {
Yap_IsPosfixOp(atom, &op, &lp, CurrentModule)) {
Term tleft = ArgOfTerm(1, t);
int bracket_left, offset;
@ -1087,7 +1087,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops && Arity == 2 &&
Yap_IsInfixOp(atom, &op, &lp, &rp)) {
Yap_IsInfixOp(atom, &op, &lp, &rp, CurrentModule)) {
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);
int bracket_left =

View File

@ -48,37 +48,45 @@ a postfix operator.
*/
op(P,T,V) :-
'$check_op'(P,T,V,op(P,T,V)),
'$op'(P, T, V).
'$yap_strip_module'(V, M, N),
'$check_top_op'(P,T,N,M,op(P,T,V)).
% just check the operator declarations for correctness.
'$check_op'(P,T,Op,G) :-
'$check_top_op'(P,T,Op,_M,G) :-
( var(P) ; var(T); var(Op)), !,
'$do_error'(instantiation_error,G).
'$check_op'(P,_,_,G) :-
'$check_top_op'(P,_,_,_,G) :-
\+ integer(P), !,
'$do_error'(type_error(integer,P),G).
'$check_op'(P,_,_,G) :-
'$check_top_op'(P,_,_,_,G) :-
P < 0, !,
'$do_error'(domain_error(operator_priority,P),G).
'$check_op'(_,T,_,G) :-
'$check_top_op'(_,T,_,_,G) :-
\+ atom(T), !,
'$do_error'(type_error(atom,T),G).
'$check_op'(_,T,_,G) :-
'$check_top_op'(_,T,_,_,G) :-
\+ '$associativity'(T), !,
'$do_error'(domain_error(operator_specifier,T),G).
'$check_op'(P,T,V,G) :-
'$check_module_for_op'(V, G, NV),
'$check_top_op'(P, T, NV, G).
'$check_top_op'(_, _, [], _) :- !.
'$check_top_op'(P, T, [Op|NV], G) :- !,
'$check_ops'(P, T, Op.NV, G).
'$check_top_op'(P, T, V, G) :-
atom(V), !,
'$check_op_name'(P, T, V, G).
'$check_top_op'(_P, _T, V, G) :-
'$do_error'(type_error(atom,V),G).
'$check_top_op'(P, T, M:Op, _M, G) :- !,
'$vsc_strip_module'(M:Op, M1, Op1),
(
atom(M1)
->
'$check_top_op'(P, T, Op1, M1, G)
;
'$do_error'(type_error(atom,Op),G)
).
'$check_top_op'(P, T, [Op|NV], M, G) :- !,
'$check_top_op'(P, T, Op, M, G),
(NV = []
->
true
;
'$check_top_op'(P, T, NV, M, G)
).
'$check_top_op'(P, T, V, M, G) :-
'$check_op_name'(P, T, V, M, G),
'$opdec'(P, T, V, M).
'$associativity'(xfx).
'$associativity'(xfy).
@ -89,43 +97,16 @@ a postfix operator.
'$associativity'(fx).
'$associativity'(fy).
'$check_module_for_op'(MOp, G, _) :-
var(MOp), !,
'$do_error'(instantiation_error,G).
'$check_module_for_op'(M:_V, G, _) :-
var(M), !,
'$do_error'(instantiation_error,G).
'$check_module_for_op'(M:V, G, NV) :-
atom(M), !,
'$check_module_for_op'(V, G, NV).
'$check_module_for_op'(M:_V, G, _) :- !,
'$do_error'(type_error(atom,M),G).
'$check_module_for_op'(V, _G, V).
'$check_ops'(_P, _T, [], _G) :- !.
'$check_ops'(P, T, [Op|NV], G) :- !,
(
var(NV)
->
'$do_error'(instantiation_error,G)
;
'$check_module_for_op'(Op, G, NOp),
'$check_op_name'(P, T, NOp, G),
'$check_ops'(P, T, NV, G)
).
'$check_ops'(_P, _T, Ops, G) :-
'$do_error'(type_error(list,Ops),G).
'$check_op_name'(_,_,V,G) :-
'$check_op_name'(_,_,V,_,G) :-
var(V), !,
'$do_error'(instantiation_error,G).
'$check_op_name'(_,_,',',G) :- !,
'$check_op_name'(_,_,',',_,G) :- !,
'$do_error'(permission_error(modify,operator,','),G).
'$check_op_name'(_,_,'[]',G) :- T \= yf, T\= xf, !,
'$check_op_name'(_,_,'[]',_,G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'[]'),G).
'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
'$check_op_name'(_,_,'{}',_,G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'{}'),G).
'$check_op_name'(P,T,'|',G) :-
'$check_op_name'(P,T,'|',_,G) :-
(
integer(P),
P < 1001, P > 0
@ -133,77 +114,31 @@ a postfix operator.
atom_codes(T,[_,_])
), !,
'$do_error'(permission_error(create,operator,'|'),G).
'$check_op_name'(_,_,V,_) :-
atom(V), !.
'$check_op_name'(_,_,A,G) :-
'$check_op_name'(P,T,A,M,_G) :-
atom(A), !,
'$opdec'( P, T, A, M).
'$check_op_name'(_,_,A,_,G) :-
'$do_error'(type_error(atom,A),G).
'$op'(P, T, ML) :-
strip_module(ML, M, [A|As]), !,
'$opl'(P, T, M, [A|As]).
'$op'(P, T, A) :-
'$op2'(P,T,A).
'$opl'(_P, _T, _, []).
'$opl'(P, T, M, [A|As]) :-
'$op2'(P, T, M:A),
'$opl'(P, T, M, As).
'$op2'(P,T,A) :-
atom(A), !,
'$opdec'(P,T,A,prolog).
'$op2'(P,T,A) :-
strip_module(A,M,N),
'$opdec'(P,T,N,M).
/** @pred current_op( _P_, _T_, _F_) is iso
Defines the relation: _P_ is a currently defined operator of type
_T_ and precedence _P_.
b*c _T_ and precedence _P_. Returns only operators defined in current module.
*/
current_op(X,Y,V) :- var(V), !,
'$current_module'(M),
'$do_current_op'(X,Y,V,M).
current_op(X,Y,M:Z) :- !,
'$current_opm'(X,Y,Z,M).
current_op(X,Y,Z) :-
'$current_module'(M),
'$do_current_op'(X,Y,Z,M).
current_op(X,Y,V) :-
'$yap_strip_module'(V,M,O),
'$do_current_op'(X, Y, O, M).
'$current_opm'(X,Y,Z,M) :-
nonvar(Y),
\+ '$associativity'(Y),
'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
'$current_opm'(X,Y,Z,M) :-
var(Z), !,
'$do_current_op'(X,Y,Z,M).
'$current_opm'(X,Y,M:Z,_) :- !,
'$current_opm'(X,Y,Z,M).
'$current_opm'(X,Y,Z,M) :-
'$do_current_op'(X,Y,Z,M).
'$do_current_op'(X,Y,Z,M) :-
'$do_current_op'(X,Y,Z, M) :-
nonvar(Y),
\+ '$associativity'(Y),
'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
'$do_current_op'(X,Y,Z,M) :-
atom(Z), !,
'$current_atom_op'(Z, M1, Prefix, Infix, Posfix),
( M1 = prolog -> true ; M1 = M ),
(
'$get_prefix'(Prefix, X, Y)
;
'$get_infix'(Infix, X, Y)
;
'$get_posfix'(Posfix, X, Y)
).
'$do_current_op'(X,Y,Z,M) :-
'$current_op'(Z, M1, Prefix, Infix, Posfix),
( M1 = prolog -> true ; M1 = M ),
'$current_op'(Z, M, Prefix, Infix, Posfix),
(
'$get_prefix'(Prefix, X, Y)
;