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:
66
C/adtdefs.c
66
C/adtdefs.c
@@ -562,62 +562,62 @@ 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;
|
||||
}
|
||||
return info;
|
||||
}
|
||||
if (oinfo) {
|
||||
READ_LOCK(oinfo->OpRWLock);
|
||||
READ_UNLOCK(ae->ARWLock);
|
||||
return oinfo;
|
||||
}
|
||||
READ_UNLOCK(ae->ARWLock);
|
||||
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);
|
||||
}
|
||||
READ_UNLOCK(ae->ARWLock);
|
||||
|
||||
return NULL;
|
||||
}
|
||||
|
||||
inline static Prop GetPredPropByAtomHavingLock(AtomEntry *ae, Term cur_mod)
|
||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||
|
@@ -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;
|
||||
}
|
||||
|
||||
|
113
C/parser.c
113
C/parser.c
@@ -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;
|
||||
@@ -524,8 +512,8 @@ 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) {
|
||||
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
|
||||
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;
|
||||
|
20
C/stdpreds.c
20
C/stdpreds.c
@@ -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);
|
||||
|
@@ -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 =
|
||||
|
Reference in New Issue
Block a user