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

SWI compatible module only operators

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1412 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-10-21 16:09:03 +00:00
parent 7ed595242a
commit f5fc38a79e
22 changed files with 348 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
C/adtdefs.c
View File

@ -282,7 +282,7 @@ GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
Prop
Yap_GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
{ /* look property list of atom a for kind */
return (GetAPropHavingLock(ae,kind));
return GetAPropHavingLock(ae,kind);
}
static Prop
@ -303,6 +303,27 @@ Yap_GetAProp(Atom a, PropFlags kind)
return GetAProp(a,kind);
}
OpEntry *
Yap_GetOpProp(Atom a)
{ /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) &&
pp->KindOfPE != OpProperty &&
((OpEntry *)pp)->OpModule &&
((OpEntry *)pp)->OpModule != CurrentModule)
pp = RepProp(pp->NextOfPE);
READ_UNLOCK(ae->ARWLock);
if (EndOfPAEntr(pp))
return NULL;
else
return (OpEntry *)pp;
}
inline static Prop
GetPredPropByAtomHavingLock(AtomEntry* ae, Term cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */

51
C/arrays.c
View File

@ -1521,11 +1521,6 @@ p_assign_static(void)
}
/* a static array */
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return (FALSE);
}
if (indx < 0 || indx >= - ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
@ -1537,6 +1532,11 @@ p_assign_static(void)
Int i;
union arith_ret v;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Yap_Eval(t3, &v) == long_int_e)
@ -1555,6 +1555,11 @@ p_assign_static(void)
Int i;
union arith_ret v;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Yap_Eval(t3, &v) == long_int_e)
@ -1577,6 +1582,11 @@ p_assign_static(void)
Int i;
union arith_ret v;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Yap_Eval(t3, &v) == long_int_e)
@ -1600,6 +1610,11 @@ p_assign_static(void)
Float f;
union arith_ret v;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsFloatTerm(t3))
f = FloatOfTerm(t3);
else if (Yap_Eval(t3, &v) == double_e)
@ -1617,6 +1632,11 @@ p_assign_static(void)
{
Int r;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntegerTerm(t3))
r = IntegerOfTerm(t3);
else {
@ -1630,6 +1650,11 @@ p_assign_static(void)
case array_of_atoms:
{
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (!IsAtomTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(TYPE_ERROR_ATOM,t3,"assign_static");
@ -1645,6 +1670,11 @@ p_assign_static(void)
Term t0 = ptr->ValueOfVE.dbrefs[indx];
DBRef p = DBRefOfTerm(t3);
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (!IsDBRefTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(TYPE_ERROR_DBREF,t3,"assign_static");
@ -1691,7 +1721,6 @@ p_assign_static(void)
{
Term told = ptr->ValueOfVE.lterms[indx].tstore;
Term tnew = Deref(ARG3);
CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive);
MaBind(livep,(CELL)livep);
@ -1699,12 +1728,12 @@ p_assign_static(void)
if (IsApplTerm(told)) {
Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
}
if (IsVarTerm(tnew)) {
if (IsVarTerm(t3)) {
RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore));
} else if (IsAtomicTerm(tnew)) {
ptr->ValueOfVE.lterms[indx].tstore = tnew;
} else if (IsAtomicTerm(t3)) {
ptr->ValueOfVE.lterms[indx].tstore = t3;
} else {
DBTerm *new = Yap_StoreTermInDB(tnew,3);
DBTerm *new = Yap_StoreTermInDB(t3,3);
if (!new) {
WRITE_UNLOCK(ptr->ArRWLock);
return FALSE;
@ -1722,7 +1751,7 @@ p_assign_static(void)
if (ref != NULL) {
Yap_ReleaseTermFromDB(ref);
}
ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(Deref(ARG3),3);
ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(t3,3);
if (ptr->ValueOfVE.terms[indx] == NULL){
WRITE_UNLOCK(ptr->ArRWLock);
return FALSE;

15
C/init.c
View File

@ -59,7 +59,7 @@ int Yap_output_msg = FALSE;
STATIC_PROTO(void InTTYLine, (char *));
#endif
#endif
STATIC_PROTO(void SetOp, (int, int, char *));
STATIC_PROTO(void SetOp, (int, int, char *, Term));
STATIC_PROTO(void InitOps, (void));
STATIC_PROTO(void InitDebug, (void));
STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate));
@ -222,7 +222,7 @@ Yap_IsOpType(char *type)
}
static int
OpDec(int p, char *type, Atom a)
OpDec(int p, char *type, Atom a, Term m)
{
int i;
AtomEntry *ae = RepAtom(a);
@ -247,6 +247,7 @@ OpDec(int p, char *type, Atom a)
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
info->KindOfPE = Ord(OpProperty);
info->NextOfPE = RepAtom(a)->PropsOfAE;
info->OpModule = m;
RepAtom(a)->PropsOfAE = AbsOpProp(info);
INIT_RWLOCK(info->OpRWLock);
WRITE_LOCK(info->OpRWLock);
@ -280,19 +281,19 @@ OpDec(int p, char *type, Atom a)
}
int
Yap_OpDec(int p, char *type, Atom a)
Yap_OpDec(int p, char *type, Atom a, Term m)
{
return(OpDec(p,type,a));
return(OpDec(p,type,a,m));
}
static void
SetOp(int p, int type, char *at)
SetOp(int p, int type, char *at, Term m)
{
#ifdef DEBUG
if (Yap_Option[5])
fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at);
#endif
OpDec(p, optypes[type], Yap_LookupAtom(at));
OpDec(p, optypes[type], Yap_LookupAtom(at), m);
}
/* Gets the info about an operator in a prop */
@ -403,7 +404,7 @@ InitOps(void)
{
unsigned int i;
for (i = 0; i < sizeof(Ops) / sizeof(*Ops); ++i)
SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName);
SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName, PROLOG_MODULE);
}
#ifdef DEBUG

47
C/iopreds.c
View File

@ -1313,9 +1313,9 @@ MemGetc (int sno)
Int ch, spos;
spos = s->u.mem_string.pos;
if (spos == s->u.mem_string.max_size)
if (spos == s->u.mem_string.max_size) {
ch = -1;
else {
} else {
ch = s->u.mem_string.buf[spos];
s->u.mem_string.pos = ++spos;
}
@ -2961,6 +2961,15 @@ p_get_read_error_handler(void)
return (Yap_unify_constant (ARG1, t));
}
/*
Assumes
Flag: ARG1
Term: ARG2
Module: ARG3
Vars: ARG4
Pos: ARG5
Err: ARG6
*/
static Int
do_read(int inp_stream)
{
@ -2969,10 +2978,17 @@ do_read(int inp_stream)
#if EMACS
int emacs_cares = FALSE;
#endif
Term tmod = Deref(ARG3), OCurrentModule = CurrentModule;
if (IsVarTerm(tmod)) {
tmod = CurrentModule;
} else if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, tmod, "read_term/2");
return FALSE;
}
if (Stream[inp_stream].status & Binary_Stream_f) {
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[inp_stream].u.file.name), "read_term/2");
return(FALSE);
return FALSE;
}
while (TRUE) {
CELL *old_H;
@ -3000,13 +3016,15 @@ do_read(int inp_stream)
} else {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG4) &&
return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG5) &&
Yap_unify_constant (ARG2, MkAtomTerm (AtomEof)));
}
}
}
repeat_cycle:
CurrentModule = tmod;
if (Yap_ErrorMessage || (t = Yap_Parse()) == 0) {
CurrentModule = OCurrentModule;
if (Yap_ErrorMessage) {
int res;
@ -3057,11 +3075,12 @@ do_read(int inp_stream)
t[1] = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
t1 = MkIntegerTerm(StartLine = tokstart->TokPos);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return(Yap_unify(t1,ARG4) &&
Yap_unify(ARG5,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t)));
return(Yap_unify(t1,ARG5) &&
Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t)));
}
}
} else {
CurrentModule = OCurrentModule;
/* parsing succeeded */
break;
}
@ -3090,27 +3109,27 @@ do_read(int inp_stream)
}
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return(Yap_unify(t, ARG2) && Yap_unify (v, ARG3) &&
Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4));
return Yap_unify(t, ARG2) && Yap_unify (v, ARG4) &&
Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG5);
} else {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return(Yap_unify(t, ARG2) && Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4));
return(Yap_unify(t, ARG2) && Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG5));
}
}
static Int
p_read (void)
{ /* '$read'(+Flag,?Term,?Vars,-Pos,-Err) */
{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
return(do_read(Yap_c_input_stream));
}
static Int
p_read2 (void)
{ /* '$read2'(+Flag,?Term,?Vars,-Pos,-Err,+Stream) */
{ /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream;
/* needs to change Yap_c_output_stream for write */
inp_stream = CheckStream (ARG6, Input_Stream_f, "read/3");
inp_stream = CheckStream (ARG7, Input_Stream_f, "read/3");
if (inp_stream == -1) {
return(FALSE);
}
@ -4860,8 +4879,8 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$read", 5, p_read, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$read", 6, p_read2, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$set_input", 1, p_set_input, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$set_output", 1, p_set_output, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag);

62
C/parser.c
View File

@ -196,74 +196,84 @@ Yap_VarNames(VarEntry *p,Term l)
}
static int
IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
IsPrefixOp(OpEntry *opp,int *pptr, int *rpptr)
{
int p;
READ_LOCK(RepOpProp(opinfo)->OpRWLock);
if ((p = RepOpProp(opinfo)->Prefix) != 0) {
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
READ_LOCK(opp->OpRWLock);
if (opp->OpModule &&
opp->OpModule != CurrentModule)
return FALSE;
if ((p = opp->Prefix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = p & MaskPrio;
if (p & DcrrpFlag)
--* rpptr;
return (TRUE);
return TRUE;
} else {
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
return (FALSE);
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
}
int
Yap_IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
Yap_IsPrefixOp(OpEntry *opinfo,int *pptr, int *rpptr)
{
return IsPrefixOp(opinfo,pptr,rpptr);
}
static int
IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr)
IsInfixOp(OpEntry *opp, int *pptr, int *lpptr, int *rpptr)
{
int p;
READ_LOCK(RepOpProp(opinfo)->OpRWLock);
if ((p = RepOpProp(opinfo)->Infix) != 0) {
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
READ_LOCK(opp->OpRWLock);
if (opp->OpModule &&
opp->OpModule != CurrentModule)
return FALSE;
if ((p = opp->Infix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = *lpptr = p & MaskPrio;
if (p & DcrrpFlag)
--* rpptr;
if (p & DcrlpFlag)
--* lpptr;
return (TRUE);
return TRUE;
} else {
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
return (FALSE);
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
}
int
Yap_IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr)
Yap_IsInfixOp(OpEntry *opinfo, int *pptr, int *lpptr, int *rpptr)
{
return IsInfixOp(opinfo, pptr, lpptr, rpptr);
}
static int
IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
IsPosfixOp(OpEntry *opp, int *pptr, int *lpptr)
{
int p;
READ_LOCK(RepOpProp(opinfo)->OpRWLock);
if ((p = RepOpProp(opinfo)->Posfix) != 0) {
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
READ_LOCK(opp->OpRWLock);
if (opp->OpModule &&
opp->OpModule != CurrentModule)
return FALSE;
if ((p = opp->Posfix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *lpptr = p & MaskPrio;
if (p & DcrlpFlag)
--* lpptr;
return (TRUE);
} else {
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
READ_UNLOCK(opp->OpRWLock);
return (FALSE);
}
}
int
Yap_IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
Yap_IsPosfixOp(OpEntry *opinfo, int *pptr, int *lpptr)
{
return IsPosfixOp(opinfo, pptr, lpptr);
}
@ -396,7 +406,7 @@ static Term
ParseTerm(int prio, JMPBUFF *FailBuff)
{
/* parse term with priority prio */
Volatile Prop opinfo;
Volatile OpEntry *opinfo;
Volatile Term t;
Volatile Functor func;
Volatile VarEntry *varinfo;
@ -408,7 +418,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
NextToken;
if ((Yap_tokptr->Tok != Ord(Ponctuation_tok)
|| Unsigned(Yap_tokptr->TokInfo) != 'l')
&& (opinfo = Yap_GetAProp((Atom) t, OpProperty))
&& (opinfo = Yap_GetOpProp((Atom) t))
&& IsPrefixOp(opinfo, &opprio, &oprprio)
) {
/* special rules apply for +1, -2.3, etc... */
@ -561,8 +571,8 @@ 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_GetAProp((Atom)(Yap_tokptr->TokInfo), OpProperty))) {
Prop save_opinfo = opinfo;
&& (opinfo = Yap_GetOpProp((Atom)(Yap_tokptr->TokInfo)))) {
OpEntry *save_opinfo = opinfo;
if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio)
&& opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */

15
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2005-09-08 22:06:45 $,$Author: rslopes $ *
* Last rev: $Date: 2005-10-21 16:09:02 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.94 2005/09/08 22:06:45 rslopes
* BEAM for YAP update...
*
* Revision 1.93 2005/08/04 15:45:53 ricroc
* TABLING NEW: support to limit the table space size
*
@ -891,8 +894,12 @@ p_opdec(void)
{ /* '$opdec'(p,type,atom) */
/* we know the arguments are integer, atom, atom */
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
return (Yap_OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE,
AtomOfTerm(at)));
Term tmod = Deref(ARG4);
if (tmod == TermProlog) {
tmod = PROLOG_MODULE;
}
return Yap_OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE,
AtomOfTerm(at), tmod);
}
@ -3233,7 +3240,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("get_value", 2, p_value, TestPredFlag|SafePredFlag|SyncPredFlag);
Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag|HiddenPredFlag);
/* general purpose */
Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$opdec", 4, p_opdec, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("name", 2, p_name, 0);
Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag);
Yap_InitCPred("atom_chars", 2, p_atom_chars, 0);

8
C/write.c
View File

@ -184,14 +184,14 @@ legalAtom(char *s) /* Is this a legal atom ? */
static int LeftOpToProtect(Atom at, int p)
{
int op, rp;
Prop opinfo = Yap_GetAProp(at, OpProperty);
OpEntry *opinfo = Yap_GetOpProp(at);
return(opinfo && Yap_IsPrefixOp(opinfo, &op, &rp) );
}
static int RightOpToProtect(Atom at, int p)
{
int op, lp;
Prop opinfo = Yap_GetAProp(at, OpProperty);
OpEntry *opinfo = Yap_GetOpProp(at);
return(opinfo && Yap_IsPosfixOp(opinfo, &op, &lp) );
}
@ -430,7 +430,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
Functor functor = FunctorOfTerm(t);
int Arity;
Atom atom;
Prop opinfo;
OpEntry *opinfo;
int op, lp, rp;
if (IsExtensionFunctor(functor)) {
@ -459,7 +459,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
}
Arity = ArityOfFunctor(functor);
atom = NameOfFunctor(functor);
opinfo = Yap_GetAProp(atom, OpProperty);
opinfo = Yap_GetOpProp(atom);
#ifdef SFUNC
if (Arity == SFArity) {
int argno = 1;

7
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.60 2005-08-17 20:13:49 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.61 2005-10-21 16:09:03 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -194,7 +194,7 @@ void STD_PROTO(Yap_KillStacks,(void));
#endif
void STD_PROTO(Yap_InitYaamRegs,(void));
void STD_PROTO(Yap_ReInitWallTime, (void));
int STD_PROTO(Yap_OpDec,(int,char *,Atom));
int STD_PROTO(Yap_OpDec,(int,char *,Atom,Term));
/* inlines.c */
void STD_PROTO(Yap_InitInlines,(void));
@ -243,9 +243,6 @@ Term STD_PROTO(Yap_MkNewPairTerm,(void));
/* parser.c */
int STD_PROTO(Yap_IsPrefixOp,(Prop,int *,int *));
int STD_PROTO(Yap_IsInfixOp,(Prop,int *,int *,int *));
int STD_PROTO(Yap_IsPosfixOp,(Prop,int *,int *));
Term STD_PROTO(Yap_Parse,(void));
/* save.c */

7
H/Yatom.h
View File

@ -268,6 +268,7 @@ typedef struct
#if defined(YAPOR) || defined(THREADS)
rwlock_t OpRWLock; /* a read-write lock to protect the entry */
#endif
Term OpModule; /* module of predicate */
BITS16 Prefix, Infix, Posfix; /* precedences */
} OpEntry;
#if USE_OFFSETS_IN_PROPS
@ -280,8 +281,6 @@ RepOpProp (Prop p)
return (OpEntry *) (AtomBase + Unsigned (p));
}
inline EXTERN Prop AbsOpProp (OpEntry * p);
inline EXTERN Prop
@ -324,7 +323,11 @@ IsOpProperty (int flags)
return (PropFlags) ((flags == OpProperty));
}
OpEntry *STD_PROTO(Yap_GetOpProp,(Atom));
int STD_PROTO(Yap_IsPrefixOp,(OpEntry *,int *,int *));
int STD_PROTO(Yap_IsInfixOp,(OpEntry *,int *,int *,int *));
int STD_PROTO(Yap_IsPosfixOp,(OpEntry *,int *,int *));
/* defines related to operator specifications */
#define MaskPrio 0x0fff

14
H/rheap.h
View File

@ -11,8 +11,12 @@
* File: rheap.h *
* comments: walk through heap code *
* *
* Last rev: $Date: 2005-10-19 19:00:48 $,$Author: vsc $ *
* Last rev: $Date: 2005-10-21 16:09:03 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.55 2005/10/19 19:00:48 vsc
* extend arrays with nb_terms so that we can implement nb_ builtins
* correctly.
*
* Revision 1.54 2005/09/09 17:24:39 vsc
* a new and hopefully much better implementation of atts.
*
@ -1090,8 +1094,14 @@ RestoreEntries(PropEntry *pp)
RestoreBB(bb);
}
break;
case ExpProperty:
case OpProperty:
{
OpEntry *opp = (OpEntry *)pp;
if (opp->OpModule) {
opp->OpModule = AtomTermAdjust(opp->OpModule);
}
}
case ExpProperty:
case ModProperty:
pp->NextOfPE =
PropAdjust(pp->NextOfPE);

35
console/yap.c
View File

@ -229,7 +229,10 @@ print_usage(void)
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr," -? Shows this screen\n");
fprintf(stderr," -b Boot file \n");
fprintf(stderr," -l Prolog file\n");
fprintf(stderr," -g Run Goal Before Top-Level \n");
fprintf(stderr," -z Run Goal Before Top-Level \n");
fprintf(stderr," -l load Prolog file\n");
fprintf(stderr," -L run Prolog file and exit\n");
fprintf(stderr," -h Heap area in Kbytes (default: %d, minimum: %d)\n",
DefHeapSpace, MinHeapSpace);
fprintf(stderr," -s Stack area in Kbytes (default: %d, minimum: %d)\n",
@ -432,6 +435,34 @@ parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
iap->YapPrologRCFile = *argv;
}
break;
/* run goal before top-level */
case 'g':
if ((*argv)[0] == '\0')
iap->YapPrologRCFile = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologGoal = *argv;
}
break;
/* run goal as top-level */
case 'z':
if ((*argv)[0] == '\0')
iap->YapPrologRCFile = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologTopLevelGoal = *argv;
}
break;
/* nf: Begin preprocessor code */
case 'D':
{
@ -487,6 +518,8 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
iap->YapPrologBootFile = NULL;
iap->YapPrologInitFile = NULL;
iap->YapPrologRCFile = NULL;
iap->YapPrologGoal = NULL;
iap->YapPrologTopLevelGoal = NULL;
iap->HaltAfterConsult = FALSE;
iap->FastBoot = FALSE;
iap->MaxTableSpaceSize = 0;

15
include/YapInterface.h
View File

@ -22,16 +22,16 @@
functions indirectly
****************************************************/
#ifndef _yap_c_interface_h
#define _yap_c_interface_h 1
#include "yap_structs.h"
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifndef _yap_c_interface_h
#define _yap_c_interface_h 1
/*
__BEGIN_DECLS should be used at the beginning of the C declarations,
so that C++ compilers don't mangle their names. __END_DECLS is used
@ -195,10 +195,11 @@ extern X_API void PROTO(YAP_UserBackCPredicate,(char *, YAP_Bool (*)(void), YAP_
extern X_API YAP_Bool PROTO(YAP_CallProlog,(YAP_Term t));
/* void cut_fail(void) */
extern X_API void PROTO(YAP_cut_fail,(void));
extern X_API void PROTO(YAP_cut_up,(void));
/* void cut_succeed(void) */
extern X_API void PROTO(YAP_cut_succeed,(void));
#define YAP_cut_succeed() { YAP_cut_up(); return TRUE; }
#define YAP_cut_fail() { YAP_cut_up(); return FALSE; }
/* void *AllocSpaceFromYAP_(int) */
extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));

4
include/yap_structs.h
View File

@ -83,6 +83,10 @@ typedef struct {
char *YapPrologInitFile;
/* if NON-NULL, name for a Prolog file to consult before entering top-level */
char *YapPrologRCFile;
/* if NON-NULL, a goal to run before top-level */
char *YapPrologGoal;
/* if NON-NULL, a goal to run as top-level */
char *YapPrologTopLevelGoal;
/* if previous NON-NULL and TRUE, halt after consulting that file */
int HaltAfterConsult;
/* ignore .yaprc, .prolog.ini, etc. files. */

17
library/swi.yap
View File

@ -9,6 +9,9 @@
:- use_module(library(lists),[nth/3]).
:- use_module(library(system),[datime/1,
mktime/2]).
:- use_module(library(terms),[term_variables/2,
term_variables/3]).
@ -161,6 +164,10 @@ prolog:append([],L,L).
prolog:append([X|L0],L,[X|Lf]) :-
prolog:append(L0,L,Lf).
prolog:member(X[X|_]).
prolog:member(X,[_|L0]) :-
prolog:member(X,L0).
tv(Term,List) :- term_variables(Term,List).
prolog:term_variables(Term,List) :- tv(Term,List).
@ -175,3 +182,13 @@ prolog:working_directory(OCWD,NCWD) :-
prolog:chdir(X) :- cd(X).
% Time is given as int, not as float.
prolog:get_time(Secs) :- datime(Datime), mktime(Datime, Secs).
% Time is received as int, and converted to "..."
prolog:convert_time(X,Y) :- swi:ctime(X,Y).

10
library/system/sys.c
View File

@ -8,8 +8,12 @@
* *
**************************************************************************
* *
* $Id: sys.c,v 1.22 2005-03-10 18:04:01 rslopes Exp $ *
* $Id: sys.c,v 1.23 2005-10-21 16:09:03 vsc Exp $ *
* mods: $Log: not supported by cvs2svn $
* mods: Revision 1.22 2005/03/10 18:04:01 rslopes
* mods: update YAP_Error arguments
* mods: to be able to compile on Windows...
* mods:
* mods: Revision 1.21 2004/08/11 16:14:54 vsc
* mods: whole lot of fixes:
* mods: - memory leak in indexing
@ -144,7 +148,7 @@ sysmktime(void)
return YAP_Unify(YAP_ARG8,YAP_MkIntTerm((long int)((f1-f0)/10000000)));
}
#else
return FALSE
return FALSE;
#endif
#else
#ifdef HAVE_MKTIME
@ -208,7 +212,7 @@ datime(void)
oops
#endif /* HAVE_TIME */
tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out);
return(YAP_Unify(YAP_ARG1, tf));
return YAP_Unify(YAP_ARG1, tf);
}
#define BUF_SIZE 1024

22
library/yap2swi/yap2swi.c
View File

@ -1320,10 +1320,28 @@ X_API int Sdprintf(char *format,...)
return 1;
}
int
static int
SWI_ctime(void)
{
YAP_Term t1 = YAP_ARG1;
if (YAP_IsVarTerm(t1)) {
YAP_Error(0,t1,"bad argumento to ctime");
return FALSE;
}
#if HAVE_CTIME
time_t tim = (time_t)YAP_IntOfTerm(t1);
return YAP_Unify(YAP_BufferToString(ctime(&tim)), YAP_ARG2);
#else
YAP_Error(0,0L,"convert_time requires ctime");
return FALSE;
#endif
}
void
swi_install(void)
{
return TRUE;
YAP_UserCPredicate("ctime", SWI_ctime, 2);
}
#ifdef _WIN32

6
library/yap2swi/yap2swi.h
View File

@ -12,8 +12,12 @@
//=== includes ===============================================================
#include "config.h"
#include <YapInterface.h>
#include <stdarg.h>
#if HAVE_TIME_H
#include <time.h>
#endif
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
@ -231,5 +235,5 @@ extern X_API int PL_action(int,...);
extern X_API int Sprintf(char *,...);
extern X_API int Sdprintf(char *,...);
int swi_install(void);
void swi_install(void);

51
pl/boot.yap
View File

@ -96,8 +96,8 @@ true :- true.
*/
/* main execution loop */
'$read_vars'(Stream,T,Pos,V) :-
'$read'(true,T,V,Pos,Err,Stream),
'$read_vars'(Stream,T,Mod,Pos,V) :-
'$read'(true,T,Mod,V,Pos,Err,Stream),
(nonvar(Err) ->
'$print_message'(error,Err), fail
;
@ -129,11 +129,17 @@ true :- true.
),
'$print_message'(informational,prompt(BreakLevel,TraceDebug)),
fail.
'$enter_top_level' :-
'$current_module'(Module),
get_value('$top_level_goal',GA), T \= [], !,
set_value('$top_level_goal',[]),
'$run_atom_goal'(GA),
set_value('$live','$false').
'$enter_top_level' :-
prompt(_,' ?- '),
prompt(' | '),
'$run_toplevel_hooks',
'$read_vars'(user_input,Command,_,Varnames),
'$read_vars'(user_input,Command,_,_,Varnames),
set_value(spy_gn,1),
( recorded('$spy_skip',_,R), erase(R), fail ; true),
( recorded('$spy_stop',_,R), erase(R), fail ; true),
@ -145,9 +151,14 @@ true :- true.
'$startup_goals' :-
recorded('$startup_goal',G,_),
'$current_module'(Module),
'$system_catch'('$query'((G->true), []),Module,Error,user:'$Error'(Error)),
'$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)),
fail.
'$startup_goals'.
'$startup_goals' :-
get_value('$init_goal',GA), GA \= [],
set_value('$init_goal',[]),
'$run_atom_goal'(GA),
fail.
'$startup_goals' :- stop_low_level_trace.
'$startup_reconsult' :-
get_value('$consult_on_boot',X), X \= [], !,
@ -723,9 +734,10 @@ not(G) :- \+ '$execute'(G).
% make sure we do not loop on undefined predicates
% for undefined_predicates.
'$enter_undefp',
'$do_undefp'(G,M).
'$find_undefp_handler'(G,M,Goal,NM), !,
'$execute'(NM:Goal).
'$do_undefp'(G,M) :-
'$find_undefp_handler'(G,M,NG,S) :-
functor(G,F,N),
recorded('$import','$import'(S,M,F,N),_),
S \= M, % can't try importing from the module itself.
@ -734,25 +746,22 @@ not(G) :- \+ '$execute'(G).
(
'$meta_expansion'(S,M,G,G1,[])
->
'$execute'(S:G1)
NG = G1
;
'$execute'(S:G)
NG = G
).
'$do_undefp'(G,M) :-
'$find_undefp_handler'(G,M,NG,M) :-
'$is_expand_goal_or_meta_predicate'(G,M),
'$system_catch'(goal_expansion(G, M, NG), user, _, fail), !,
'$exit_undefp',
'$execute0'(NG,M).
'$do_undefp'(G,M) :-
'$exit_undefp'.
'$find_undefp_handler'(G,M,NG,user) :-
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)),
'$exit_undefp', !,
'$execute'(user:NG).
'$do_undefp'(G,M) :-
'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), !,
'$exit_undefp'.
'$find_undefp_handler'(G,M,US,user) :-
recorded('$unknown','$unknown'(M:G,US),_), !,
'$exit_undefp',
'$execute'(user:US).
'$do_undefp'(_,_) :-
'$exit_undefp'.
'$find_undefp_handler'(G,M,_,_) :-
'$exit_undefp',
fail.
@ -821,7 +830,7 @@ bootstrap(F) :-
!.
'$enter_command'(Stream,Status) :-
'$read_vars'(Stream,Command,_,Vars),
'$read_vars'(Stream,Command,_,_,Vars),
'$command'(Command,Vars,Status).
'$abort_loop'(Stream) :-

10
pl/debug.yap
View File

@ -416,12 +416,20 @@ debugging :-
'$execute_nonstop'(G, M).
'$spycall'(G, M, InControl) :-
'$flags'(G,M,F,F),
F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, or source
F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, user-C, or source
% use the interpreter
CP is '$last_choice_pt',
'$clause'(G, M, Cl),
'$do_not_creep',
'$do_spy'(Cl, M, CP, InControl).
'$spycall'(G, M, InControl) :-
'$undefined'(G, M), !,
'$enter_undefp',
(
'$find_undefp_handler'(G,M,Goal,NM)
->
'$spycall'(Goal, NM, InControl)
).
'$spycall'(G, M, InControl) :-
% I lost control here.
CP is '$last_choice_pt',

12
pl/modules.yap
View File

@ -85,7 +85,17 @@ module(N) :-
recorded('$module','$module'(F0,Mod,_),R), !,
'$add_preexisting_module_on_file'(F, F0, Mod, Exports, R).
'$add_module_on_file'(Mod, F, Exports) :-
recorda('$module','$module'(F,Mod,Exports),_).
'$process_exports'(Exports,Mod,ExportedPreds),
recorda('$module','$module'(F,Mod,ExportedPreds),_).
'$process_exports'([],_,[]).
'$process_exports'([Name/Arity|Exports],Mod,[Name/Arity|ExportedPreds]):- !,
'$process_exports'(Exports,Mod,ExportedPreds).
'$process_exports'([op(Prio,Assoc,Name)|Exports],Mod,ExportedPreds) :- !,
'$opdec'(Prio,Assoc,Name,Mod),
'$process_exports'(Exports,Mod,ExportedPreds).
'$process_exports'([Trash|Exports],Mod,_) :-
'$do_error'(type_error(predicate_indicator,Trash),module(Mod,[Trash])).
% redefining a previously-defined file, no problem.
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !,

13
pl/utils.yap
View File

@ -176,7 +176,7 @@ op(P,T,V) :- '$op2'(P,T,V).
'$op'(P,T,',') :- !,
'$do_error'(permission_error(modify,operator,','),op(P,T,',')).
'$op'(P,T,A) :- '$opdec'(P,T,A).
'$op'(P,T,A) :- '$opdec'(P,T,A,prolog).
%%% Operating System utilities
@ -725,3 +725,14 @@ nth_instance(X,Y,Z) :-
nth_instance(X,Y,Z) :-
'$nth_instance'(X,Y,Z).
'$run_atom_goal'(GA) :-
'$current_module'(Module),
atom_codes(GA,Gs),
charsio:open_mem_read_stream(Gs, Stream),
( '$system_catch'(read(Stream, G),Module,_,fail) ->
close(Stream)
;
close(Stream),
fail
),
'$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)).

28
pl/yio.yap
View File

@ -147,7 +147,8 @@ open(F,T,S,Opts) :-
'$check_opt_read'(singletons(_), _) :- !.
'$check_opt_read'(syntax_errors(T), G) :- !,
'$check_read_syntax_errors_arg'(T, G).
'$check_opt_read'(term_position(_), G) :- !.
'$check_opt_read'(term_position(_), _) :- !.
'$check_opt_read'(module(_), _) :- !.
'$check_opt_read'(A, G) :-
'$do_error'(domain_error(read_option,A),G).
@ -316,7 +317,7 @@ told :- current_output(Stream), '$close'(Stream), set_output(user).
/* Term IO */
read(T) :-
'$read'(false,T,_,_,Err),
'$read'(false,T,_,_,_,Err),
(nonvar(Err) ->
'$print_message'(error,Err), fail
;
@ -324,7 +325,7 @@ read(T) :-
).
read(Stream,T) :-
'$read'(false,T,V,_,Err,Stream),
'$read'(false,T,_,_,_,Err,Stream),
(nonvar(Err) ->
'$print_message'(error,Err), fail
;
@ -334,27 +335,29 @@ read(Stream,T) :-
read_term(T, Options) :-
'$check_io_opts'(Options,read_term(T, Options)),
current_input(S),
'$preprocess_read_terms_options'(Options),
'$read_vars'(S,T,Pos,VL),
'$preprocess_read_terms_options'(Options,Module),
'$read_vars'(S,T,Module,Pos,VL),
'$postprocess_read_terms_options'(Options, T, VL, Pos).
read_term(Stream, T, Options) :-
'$check_io_opts'(Options,read_term(T, Options)),
'$preprocess_read_terms_options'(Options),
'$read_vars'(Stream,T,Pos,VL),
'$preprocess_read_terms_options'(Options,Module),
'$read_vars'(Stream,T,Module,Pos,VL),
'$postprocess_read_terms_options'(Options, T, VL, Pos).
%
% support flags to read
%
'$preprocess_read_terms_options'([]).
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !,
'$preprocess_read_terms_options'([],_).
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L],Mod) :- !,
'$get_read_error_handler'(OldVal),
set_value('$read_term_error_handler', OldVal),
'$set_read_error_handler'(NewVal),
'$preprocess_read_terms_options'(L).
'$preprocess_read_terms_options'([_|L]) :-
'$preprocess_read_terms_options'(L).
'$preprocess_read_terms_options'(L,Mod).
'$preprocess_read_terms_options'([module(Mod)|L],Mod) :- !,
'$preprocess_read_terms_options'(L,Mod).
'$preprocess_read_terms_options'([_|L],Mod) :-
'$preprocess_read_terms_options'(L,Mod).
'$postprocess_read_terms_options'([], _, _, _).
'$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !,
@ -377,6 +380,7 @@ read_term(Stream, T, Options) :-
'$postprocess_read_terms_option'(variables(Val), T, _, _) :-
'$variables_in_term'(T, [], Val).
'$postprocess_read_terms_option'(term_position(Pos), _, _, Pos).
'$postprocess_read_terms_option'(module(_), _, _, _).
%'$postprocess_read_terms_option'(cycles(Val), _, _).
'$read_term_non_anonymous'([], []).