diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

support for module based operators.

Browse Source
This commit is contained in:
Vitor Santos Costa
2009-11-20 00:33:14 +00:00
parent a2927c4a72
commit ffe1dfdfff
11 changed files with 133 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
C/adtdefs.c
View File

@@ -413,7 +413,24 @@ Yap_GetAProp(Atom a, PropFlags kind)
}
OpEntry *
Yap_GetOpProp(Atom a)
Yap_GetOpPropForAModuleHavingALock(Atom a, Term mod)
{ /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) &&
(pp->KindOfPE != OpProperty ||
((OpEntry *)pp)->OpModule != mod))
pp = RepProp(pp->NextOfPE);
if (EndOfPAEntr(pp)) {
return NULL;
}
return (OpEntry *)pp;
}
int
Yap_HasOp(Atom a)
{ /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
@@ -421,15 +438,55 @@ Yap_GetOpProp(Atom a)
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) &&
( pp->KindOfPE != OpProperty ||
(((OpEntry *)pp)->OpModule &&
((OpEntry *)pp)->OpModule != CurrentModule)))
( pp->KindOfPE != OpProperty))
pp = RepProp(pp->NextOfPE);
READ_UNLOCK(ae->ARWLock);
if (EndOfPAEntr(pp))
if (EndOfPAEntr(pp)) {
return FALSE;
} else {
return TRUE;
}
}
OpEntry *
Yap_GetOpProp(Atom a, op_type type)
{ /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *info = NULL;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) &&
( pp->KindOfPE != OpProperty ||
((OpEntry *)pp)->OpModule != CurrentModule))
pp = RepProp(pp->NextOfPE);
if ((info = (OpEntry *)pp)) {
if ((type == INFIX_OP && !info->Infix) ||
(type == POSFIX_OP && !info->Posfix) ||
(type == PREFIX_OP && !info->Prefix))
pp = RepProp(NIL);
}
if (EndOfPAEntr(pp)) {
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) &&
( pp->KindOfPE != OpProperty ||
((OpEntry *)pp)->OpModule != PROLOG_MODULE))
pp = RepProp(pp->NextOfPE);
if ((info = (OpEntry *)pp)) {
if ((type == INFIX_OP && !info->Infix) ||
(type == POSFIX_OP && !info->Posfix) ||
(type == PREFIX_OP && !info->Prefix))
pp = RepProp(NIL);
}
}
if (!info) {
READ_UNLOCK(ae->ARWLock);
return NULL;
else
return (OpEntry *)pp;
} else {
READ_LOCK(info->OpRWLock);
READ_UNLOCK(ae->ARWLock);
return info;
}
}

8
C/init.c
View File

@@ -229,6 +229,8 @@ OpDec(int p, char *type, Atom a, Term m)
AtomEntry *ae = RepAtom(a);
OpEntry *info;
if (m == TermProlog)
m = PROLOG_MODULE;
for (i = 1; i <= 7; ++i)
if (strcmp(type, optypes[i]) == 0)
break;
@@ -243,7 +245,7 @@ OpDec(int p, char *type, Atom a, Term m)
p |= DcrrpFlag;
}
WRITE_LOCK(ae->ARWLock);
info = RepOpProp(Yap_GetAPropHavingLock(ae, OpProperty));
info = Yap_GetOpPropForAModuleHavingALock(ae, m);
if (EndOfPAEntr(info)) {
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
info->KindOfPE = Ord(OpProperty);
@@ -269,7 +271,7 @@ OpDec(int p, char *type, Atom a, Term m)
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
return(FALSE);
return FALSE;
}
info->Infix = p;
} else if (i <= 5) {
@@ -278,7 +280,7 @@ OpDec(int p, char *type, Atom a, Term m)
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
return(FALSE);
return FALSE;
}
info->Posfix = p;
} else {

41
C/parser.c
View File

@@ -198,11 +198,13 @@ Yap_VarNames(VarEntry *p,Term l)
}
static int
IsPrefixOp(OpEntry *opp,int *pptr, int *rpptr)
IsPrefixOp(Atom op,int *pptr, int *rpptr)
{
int p;
READ_LOCK(opp->OpRWLock);
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP);
if (!opp)
return FALSE;
if (opp->OpModule &&
opp->OpModule != CurrentModule)
return FALSE;
@@ -219,17 +221,19 @@ IsPrefixOp(OpEntry *opp,int *pptr, int *rpptr)
}
int
Yap_IsPrefixOp(OpEntry *opinfo,int *pptr, int *rpptr)
Yap_IsPrefixOp(Atom op,int *pptr, int *rpptr)
{
return IsPrefixOp(opinfo,pptr,rpptr);
return IsPrefixOp(op,pptr,rpptr);
}
static int
IsInfixOp(OpEntry *opp, int *pptr, int *lpptr, int *rpptr)
IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr)
{
int p;
READ_LOCK(opp->OpRWLock);
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP);
if (!opp)
return FALSE;
if (opp->OpModule &&
opp->OpModule != CurrentModule)
return FALSE;
@@ -248,17 +252,19 @@ IsInfixOp(OpEntry *opp, int *pptr, int *lpptr, int *rpptr)
}
int
Yap_IsInfixOp(OpEntry *opinfo, int *pptr, int *lpptr, int *rpptr)
Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr)
{
return IsInfixOp(opinfo, pptr, lpptr, rpptr);
return IsInfixOp(op, pptr, lpptr, rpptr);
}
static int
IsPosfixOp(OpEntry *opp, int *pptr, int *lpptr)
IsPosfixOp(Atom op, int *pptr, int *lpptr)
{
int p;
READ_LOCK(opp->OpRWLock);
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP);
if (!opp)
return FALSE;
if (opp->OpModule &&
opp->OpModule != CurrentModule)
return FALSE;
@@ -275,9 +281,9 @@ IsPosfixOp(OpEntry *opp, int *pptr, int *lpptr)
}
int
Yap_IsPosfixOp(OpEntry *opinfo, int *pptr, int *lpptr)
Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr)
{
return IsPosfixOp(opinfo, pptr, lpptr);
return IsPosfixOp(op, pptr, lpptr);
}
inline static void
@@ -418,11 +424,11 @@ static Term
ParseTerm(int prio, JMPBUFF *FailBuff)
{
/* parse term with priority prio */
Volatile OpEntry *opinfo;
Volatile Term t;
Volatile Functor func;
Volatile VarEntry *varinfo;
Volatile int curprio = 0, opprio, oplprio, oprprio;
Volatile Atom opinfo;
switch (Yap_tokptr->Tok) {
case Name_tok:
@@ -430,8 +436,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
NextToken;
if ((Yap_tokptr->Tok != Ord(Ponctuation_tok)
|| Unsigned(Yap_tokptr->TokInfo) != 'l')
&& (opinfo = Yap_GetOpProp((Atom) t))
&& IsPrefixOp(opinfo, &opprio, &oprprio)
&& IsPrefixOp((Atom)t, &opprio, &oprprio)
) {
/* special rules apply for +1, -2.3, etc... */
if (Yap_tokptr->Tok == Number_tok) {
@@ -615,9 +620,9 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
/* main loop to parse infix and posfix operators starts here */
while (TRUE) {
if (Yap_tokptr->Tok == Ord(Name_tok)
&& (opinfo = Yap_GetOpProp((Atom)(Yap_tokptr->TokInfo)))) {
OpEntry *save_opinfo = opinfo;
if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio)
&& Yap_HasOp((Atom)(Yap_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(Yap_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio)
&& opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */
Volatile int oldprio = curprio;

16
C/write.c
View File

@@ -217,15 +217,13 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */
static int LeftOpToProtect(Atom at, int p)
{
int op, rp;
OpEntry *opinfo = Yap_GetOpProp(at);
return(opinfo && Yap_IsPrefixOp(opinfo, &op, &rp) );
return Yap_IsPrefixOp(at, &op, &rp);
}
static int RightOpToProtect(Atom at, int p)
{
int op, lp;
OpEntry *opinfo = Yap_GetOpProp(at);
return(opinfo && Yap_IsPosfixOp(opinfo, &op, &lp) );
return Yap_IsPosfixOp(at, &op, &lp);
}
static wtype
@@ -612,7 +610,6 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
Functor functor = FunctorOfTerm(t);
int Arity;
Atom atom;
OpEntry *opinfo;
int op, lp, rp;
if (IsExtensionFunctor(functor)) {
@@ -689,7 +686,6 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
}
Arity = ArityOfFunctor(functor);
atom = NameOfFunctor(functor);
opinfo = Yap_GetOpProp(atom);
#ifdef SFUNC
if (Arity == SFArity) {
int argno = 1;
@@ -744,8 +740,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
return;
}
if (!wglb->Ignore_ops &&
Arity == 1 && opinfo && Yap_IsPrefixOp(opinfo, &op,
&rp)
Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)
#ifdef DO_NOT_WRITE_PLUS_AND_MINUS_AS_PREFIX
&&
/* never write '+' and '-' as infix
@@ -782,7 +777,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
lastw = separator;
}
} else if (!wglb->Ignore_ops &&
Arity == 1 && opinfo && Yap_IsPosfixOp(opinfo, &op, &lp)) {
Arity == 1 &&
Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
long sl = 0;
int bracket_left =
@@ -820,7 +816,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
lastw = separator;
}
} else if (!wglb->Ignore_ops &&
Arity == 2 && opinfo && Yap_IsInfixOp(opinfo, &op, &lp,
Arity == 2 && Yap_IsInfixOp(atom, &op, &lp,
&rp) ) {
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);