SWI compatible module only operators
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1412 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
7ed595242a
commit
f5fc38a79e
23
C/adtdefs.c
23
C/adtdefs.c
@ -282,7 +282,7 @@ GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
|
|||||||
Prop
|
Prop
|
||||||
Yap_GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
|
Yap_GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
|
||||||
{ /* look property list of atom a for kind */
|
{ /* look property list of atom a for kind */
|
||||||
return (GetAPropHavingLock(ae,kind));
|
return GetAPropHavingLock(ae,kind);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Prop
|
static Prop
|
||||||
@ -303,6 +303,27 @@ Yap_GetAProp(Atom a, PropFlags kind)
|
|||||||
return GetAProp(a,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
|
inline static Prop
|
||||||
GetPredPropByAtomHavingLock(AtomEntry* ae, Term cur_mod)
|
GetPredPropByAtomHavingLock(AtomEntry* ae, Term cur_mod)
|
||||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||||
|
53
C/arrays.c
53
C/arrays.c
@ -1521,12 +1521,7 @@ p_assign_static(void)
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* a static array */
|
/* a static array */
|
||||||
if (IsVarTerm(t3)) {
|
if (indx < 0 || indx >= - ptr->ArrayEArity) {
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
|
||||||
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
|
||||||
return (FALSE);
|
|
||||||
}
|
|
||||||
if (indx < 0 || indx >= - ptr->ArrayEArity) {
|
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
|
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
@ -1537,6 +1532,11 @@ p_assign_static(void)
|
|||||||
Int i;
|
Int i;
|
||||||
union arith_ret v;
|
union arith_ret v;
|
||||||
|
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (IsIntTerm(t3))
|
if (IsIntTerm(t3))
|
||||||
i = IntOfTerm(t3);
|
i = IntOfTerm(t3);
|
||||||
else if (Yap_Eval(t3, &v) == long_int_e)
|
else if (Yap_Eval(t3, &v) == long_int_e)
|
||||||
@ -1555,6 +1555,11 @@ p_assign_static(void)
|
|||||||
Int i;
|
Int i;
|
||||||
union arith_ret v;
|
union arith_ret v;
|
||||||
|
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (IsIntTerm(t3))
|
if (IsIntTerm(t3))
|
||||||
i = IntOfTerm(t3);
|
i = IntOfTerm(t3);
|
||||||
else if (Yap_Eval(t3, &v) == long_int_e)
|
else if (Yap_Eval(t3, &v) == long_int_e)
|
||||||
@ -1577,6 +1582,11 @@ p_assign_static(void)
|
|||||||
Int i;
|
Int i;
|
||||||
union arith_ret v;
|
union arith_ret v;
|
||||||
|
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (IsIntTerm(t3))
|
if (IsIntTerm(t3))
|
||||||
i = IntOfTerm(t3);
|
i = IntOfTerm(t3);
|
||||||
else if (Yap_Eval(t3, &v) == long_int_e)
|
else if (Yap_Eval(t3, &v) == long_int_e)
|
||||||
@ -1600,6 +1610,11 @@ p_assign_static(void)
|
|||||||
Float f;
|
Float f;
|
||||||
union arith_ret v;
|
union arith_ret v;
|
||||||
|
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (IsFloatTerm(t3))
|
if (IsFloatTerm(t3))
|
||||||
f = FloatOfTerm(t3);
|
f = FloatOfTerm(t3);
|
||||||
else if (Yap_Eval(t3, &v) == double_e)
|
else if (Yap_Eval(t3, &v) == double_e)
|
||||||
@ -1617,6 +1632,11 @@ p_assign_static(void)
|
|||||||
{
|
{
|
||||||
Int r;
|
Int r;
|
||||||
|
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (IsIntegerTerm(t3))
|
if (IsIntegerTerm(t3))
|
||||||
r = IntegerOfTerm(t3);
|
r = IntegerOfTerm(t3);
|
||||||
else {
|
else {
|
||||||
@ -1630,6 +1650,11 @@ p_assign_static(void)
|
|||||||
|
|
||||||
case array_of_atoms:
|
case array_of_atoms:
|
||||||
{
|
{
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (!IsAtomTerm(t3)) {
|
if (!IsAtomTerm(t3)) {
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
Yap_Error(TYPE_ERROR_ATOM,t3,"assign_static");
|
Yap_Error(TYPE_ERROR_ATOM,t3,"assign_static");
|
||||||
@ -1645,6 +1670,11 @@ p_assign_static(void)
|
|||||||
Term t0 = ptr->ValueOfVE.dbrefs[indx];
|
Term t0 = ptr->ValueOfVE.dbrefs[indx];
|
||||||
DBRef p = DBRefOfTerm(t3);
|
DBRef p = DBRefOfTerm(t3);
|
||||||
|
|
||||||
|
if (IsVarTerm(t3)) {
|
||||||
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
if (!IsDBRefTerm(t3)) {
|
if (!IsDBRefTerm(t3)) {
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
Yap_Error(TYPE_ERROR_DBREF,t3,"assign_static");
|
Yap_Error(TYPE_ERROR_DBREF,t3,"assign_static");
|
||||||
@ -1691,7 +1721,6 @@ p_assign_static(void)
|
|||||||
|
|
||||||
{
|
{
|
||||||
Term told = ptr->ValueOfVE.lterms[indx].tstore;
|
Term told = ptr->ValueOfVE.lterms[indx].tstore;
|
||||||
Term tnew = Deref(ARG3);
|
|
||||||
|
|
||||||
CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive);
|
CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive);
|
||||||
MaBind(livep,(CELL)livep);
|
MaBind(livep,(CELL)livep);
|
||||||
@ -1699,12 +1728,12 @@ p_assign_static(void)
|
|||||||
if (IsApplTerm(told)) {
|
if (IsApplTerm(told)) {
|
||||||
Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
|
Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
|
||||||
}
|
}
|
||||||
if (IsVarTerm(tnew)) {
|
if (IsVarTerm(t3)) {
|
||||||
RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore));
|
RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore));
|
||||||
} else if (IsAtomicTerm(tnew)) {
|
} else if (IsAtomicTerm(t3)) {
|
||||||
ptr->ValueOfVE.lterms[indx].tstore = tnew;
|
ptr->ValueOfVE.lterms[indx].tstore = t3;
|
||||||
} else {
|
} else {
|
||||||
DBTerm *new = Yap_StoreTermInDB(tnew,3);
|
DBTerm *new = Yap_StoreTermInDB(t3,3);
|
||||||
if (!new) {
|
if (!new) {
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
return FALSE;
|
return FALSE;
|
||||||
@ -1722,7 +1751,7 @@ p_assign_static(void)
|
|||||||
if (ref != NULL) {
|
if (ref != NULL) {
|
||||||
Yap_ReleaseTermFromDB(ref);
|
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){
|
if (ptr->ValueOfVE.terms[indx] == NULL){
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
return FALSE;
|
return FALSE;
|
||||||
|
15
C/init.c
15
C/init.c
@ -59,7 +59,7 @@ int Yap_output_msg = FALSE;
|
|||||||
STATIC_PROTO(void InTTYLine, (char *));
|
STATIC_PROTO(void InTTYLine, (char *));
|
||||||
#endif
|
#endif
|
||||||
#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 InitOps, (void));
|
||||||
STATIC_PROTO(void InitDebug, (void));
|
STATIC_PROTO(void InitDebug, (void));
|
||||||
STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate));
|
STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate));
|
||||||
@ -222,7 +222,7 @@ Yap_IsOpType(char *type)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
OpDec(int p, char *type, Atom a)
|
OpDec(int p, char *type, Atom a, Term m)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
AtomEntry *ae = RepAtom(a);
|
AtomEntry *ae = RepAtom(a);
|
||||||
@ -247,6 +247,7 @@ OpDec(int p, char *type, Atom a)
|
|||||||
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
|
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
|
||||||
info->KindOfPE = Ord(OpProperty);
|
info->KindOfPE = Ord(OpProperty);
|
||||||
info->NextOfPE = RepAtom(a)->PropsOfAE;
|
info->NextOfPE = RepAtom(a)->PropsOfAE;
|
||||||
|
info->OpModule = m;
|
||||||
RepAtom(a)->PropsOfAE = AbsOpProp(info);
|
RepAtom(a)->PropsOfAE = AbsOpProp(info);
|
||||||
INIT_RWLOCK(info->OpRWLock);
|
INIT_RWLOCK(info->OpRWLock);
|
||||||
WRITE_LOCK(info->OpRWLock);
|
WRITE_LOCK(info->OpRWLock);
|
||||||
@ -280,19 +281,19 @@ OpDec(int p, char *type, Atom a)
|
|||||||
}
|
}
|
||||||
|
|
||||||
int
|
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
|
static void
|
||||||
SetOp(int p, int type, char *at)
|
SetOp(int p, int type, char *at, Term m)
|
||||||
{
|
{
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
if (Yap_Option[5])
|
if (Yap_Option[5])
|
||||||
fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at);
|
fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at);
|
||||||
#endif
|
#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 */
|
/* Gets the info about an operator in a prop */
|
||||||
@ -403,7 +404,7 @@ InitOps(void)
|
|||||||
{
|
{
|
||||||
unsigned int i;
|
unsigned int i;
|
||||||
for (i = 0; i < sizeof(Ops) / sizeof(*Ops); ++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
|
#ifdef DEBUG
|
||||||
|
47
C/iopreds.c
47
C/iopreds.c
@ -1313,9 +1313,9 @@ MemGetc (int sno)
|
|||||||
Int ch, spos;
|
Int ch, spos;
|
||||||
|
|
||||||
spos = s->u.mem_string.pos;
|
spos = s->u.mem_string.pos;
|
||||||
if (spos == s->u.mem_string.max_size)
|
if (spos == s->u.mem_string.max_size) {
|
||||||
ch = -1;
|
ch = -1;
|
||||||
else {
|
} else {
|
||||||
ch = s->u.mem_string.buf[spos];
|
ch = s->u.mem_string.buf[spos];
|
||||||
s->u.mem_string.pos = ++spos;
|
s->u.mem_string.pos = ++spos;
|
||||||
}
|
}
|
||||||
@ -2961,6 +2961,15 @@ p_get_read_error_handler(void)
|
|||||||
return (Yap_unify_constant (ARG1, t));
|
return (Yap_unify_constant (ARG1, t));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
Assumes
|
||||||
|
Flag: ARG1
|
||||||
|
Term: ARG2
|
||||||
|
Module: ARG3
|
||||||
|
Vars: ARG4
|
||||||
|
Pos: ARG5
|
||||||
|
Err: ARG6
|
||||||
|
*/
|
||||||
static Int
|
static Int
|
||||||
do_read(int inp_stream)
|
do_read(int inp_stream)
|
||||||
{
|
{
|
||||||
@ -2969,10 +2978,17 @@ do_read(int inp_stream)
|
|||||||
#if EMACS
|
#if EMACS
|
||||||
int emacs_cares = FALSE;
|
int emacs_cares = FALSE;
|
||||||
#endif
|
#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) {
|
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");
|
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[inp_stream].u.file.name), "read_term/2");
|
||||||
return(FALSE);
|
return FALSE;
|
||||||
}
|
}
|
||||||
while (TRUE) {
|
while (TRUE) {
|
||||||
CELL *old_H;
|
CELL *old_H;
|
||||||
@ -3000,13 +3016,15 @@ do_read(int inp_stream)
|
|||||||
} else {
|
} else {
|
||||||
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
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)));
|
Yap_unify_constant (ARG2, MkAtomTerm (AtomEof)));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
repeat_cycle:
|
repeat_cycle:
|
||||||
|
CurrentModule = tmod;
|
||||||
if (Yap_ErrorMessage || (t = Yap_Parse()) == 0) {
|
if (Yap_ErrorMessage || (t = Yap_Parse()) == 0) {
|
||||||
|
CurrentModule = OCurrentModule;
|
||||||
if (Yap_ErrorMessage) {
|
if (Yap_ErrorMessage) {
|
||||||
int res;
|
int res;
|
||||||
|
|
||||||
@ -3057,11 +3075,12 @@ do_read(int inp_stream)
|
|||||||
t[1] = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
|
t[1] = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
|
||||||
t1 = MkIntegerTerm(StartLine = tokstart->TokPos);
|
t1 = MkIntegerTerm(StartLine = tokstart->TokPos);
|
||||||
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
||||||
return(Yap_unify(t1,ARG4) &&
|
return(Yap_unify(t1,ARG5) &&
|
||||||
Yap_unify(ARG5,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t)));
|
Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t)));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
|
CurrentModule = OCurrentModule;
|
||||||
/* parsing succeeded */
|
/* parsing succeeded */
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -3090,27 +3109,27 @@ do_read(int inp_stream)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
||||||
return(Yap_unify(t, ARG2) && Yap_unify (v, ARG3) &&
|
return Yap_unify(t, ARG2) && Yap_unify (v, ARG4) &&
|
||||||
Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4));
|
Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG5);
|
||||||
} else {
|
} else {
|
||||||
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
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
|
static Int
|
||||||
p_read (void)
|
p_read (void)
|
||||||
{ /* '$read'(+Flag,?Term,?Vars,-Pos,-Err) */
|
{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
|
||||||
return(do_read(Yap_c_input_stream));
|
return(do_read(Yap_c_input_stream));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_read2 (void)
|
p_read2 (void)
|
||||||
{ /* '$read2'(+Flag,?Term,?Vars,-Pos,-Err,+Stream) */
|
{ /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||||
int inp_stream;
|
int inp_stream;
|
||||||
|
|
||||||
/* needs to change Yap_c_output_stream for write */
|
/* 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) {
|
if (inp_stream == -1) {
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
@ -4860,8 +4879,8 @@ Yap_InitIOPreds(void)
|
|||||||
Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
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 ("$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 ("$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_read, SyncPredFlag|HiddenPredFlag);
|
||||||
Yap_InitCPred ("$read", 6, p_read2, SyncPredFlag|HiddenPredFlag);
|
Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag);
|
||||||
Yap_InitCPred ("$set_input", 1, p_set_input, SafePredFlag|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 ("$set_output", 1, p_set_output, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||||
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||||
|
62
C/parser.c
62
C/parser.c
@ -196,74 +196,84 @@ Yap_VarNames(VarEntry *p,Term l)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
|
IsPrefixOp(OpEntry *opp,int *pptr, int *rpptr)
|
||||||
{
|
{
|
||||||
int p;
|
int p;
|
||||||
|
|
||||||
READ_LOCK(RepOpProp(opinfo)->OpRWLock);
|
READ_LOCK(opp->OpRWLock);
|
||||||
if ((p = RepOpProp(opinfo)->Prefix) != 0) {
|
if (opp->OpModule &&
|
||||||
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
|
opp->OpModule != CurrentModule)
|
||||||
|
return FALSE;
|
||||||
|
if ((p = opp->Prefix) != 0) {
|
||||||
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
*pptr = *rpptr = p & MaskPrio;
|
*pptr = *rpptr = p & MaskPrio;
|
||||||
if (p & DcrrpFlag)
|
if (p & DcrrpFlag)
|
||||||
--* rpptr;
|
--* rpptr;
|
||||||
return (TRUE);
|
return TRUE;
|
||||||
} else {
|
} else {
|
||||||
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
return (FALSE);
|
return FALSE;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int
|
int
|
||||||
Yap_IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
|
Yap_IsPrefixOp(OpEntry *opinfo,int *pptr, int *rpptr)
|
||||||
{
|
{
|
||||||
return IsPrefixOp(opinfo,pptr,rpptr);
|
return IsPrefixOp(opinfo,pptr,rpptr);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr)
|
IsInfixOp(OpEntry *opp, int *pptr, int *lpptr, int *rpptr)
|
||||||
{
|
{
|
||||||
int p;
|
int p;
|
||||||
|
|
||||||
READ_LOCK(RepOpProp(opinfo)->OpRWLock);
|
READ_LOCK(opp->OpRWLock);
|
||||||
if ((p = RepOpProp(opinfo)->Infix) != 0) {
|
if (opp->OpModule &&
|
||||||
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
|
opp->OpModule != CurrentModule)
|
||||||
|
return FALSE;
|
||||||
|
if ((p = opp->Infix) != 0) {
|
||||||
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
*pptr = *rpptr = *lpptr = p & MaskPrio;
|
*pptr = *rpptr = *lpptr = p & MaskPrio;
|
||||||
if (p & DcrrpFlag)
|
if (p & DcrrpFlag)
|
||||||
--* rpptr;
|
--* rpptr;
|
||||||
if (p & DcrlpFlag)
|
if (p & DcrlpFlag)
|
||||||
--* lpptr;
|
--* lpptr;
|
||||||
return (TRUE);
|
return TRUE;
|
||||||
} else {
|
} else {
|
||||||
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
return (FALSE);
|
return FALSE;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int
|
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);
|
return IsInfixOp(opinfo, pptr, lpptr, rpptr);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
|
IsPosfixOp(OpEntry *opp, int *pptr, int *lpptr)
|
||||||
{
|
{
|
||||||
int p;
|
int p;
|
||||||
READ_LOCK(RepOpProp(opinfo)->OpRWLock);
|
|
||||||
if ((p = RepOpProp(opinfo)->Posfix) != 0) {
|
READ_LOCK(opp->OpRWLock);
|
||||||
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
|
if (opp->OpModule &&
|
||||||
|
opp->OpModule != CurrentModule)
|
||||||
|
return FALSE;
|
||||||
|
if ((p = opp->Posfix) != 0) {
|
||||||
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
*pptr = *lpptr = p & MaskPrio;
|
*pptr = *lpptr = p & MaskPrio;
|
||||||
if (p & DcrlpFlag)
|
if (p & DcrlpFlag)
|
||||||
--* lpptr;
|
--* lpptr;
|
||||||
return (TRUE);
|
return (TRUE);
|
||||||
} else {
|
} else {
|
||||||
READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int
|
int
|
||||||
Yap_IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
|
Yap_IsPosfixOp(OpEntry *opinfo, int *pptr, int *lpptr)
|
||||||
{
|
{
|
||||||
return IsPosfixOp(opinfo, pptr, lpptr);
|
return IsPosfixOp(opinfo, pptr, lpptr);
|
||||||
}
|
}
|
||||||
@ -396,7 +406,7 @@ static Term
|
|||||||
ParseTerm(int prio, JMPBUFF *FailBuff)
|
ParseTerm(int prio, JMPBUFF *FailBuff)
|
||||||
{
|
{
|
||||||
/* parse term with priority prio */
|
/* parse term with priority prio */
|
||||||
Volatile Prop opinfo;
|
Volatile OpEntry *opinfo;
|
||||||
Volatile Term t;
|
Volatile Term t;
|
||||||
Volatile Functor func;
|
Volatile Functor func;
|
||||||
Volatile VarEntry *varinfo;
|
Volatile VarEntry *varinfo;
|
||||||
@ -408,7 +418,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
|
|||||||
NextToken;
|
NextToken;
|
||||||
if ((Yap_tokptr->Tok != Ord(Ponctuation_tok)
|
if ((Yap_tokptr->Tok != Ord(Ponctuation_tok)
|
||||||
|| Unsigned(Yap_tokptr->TokInfo) != 'l')
|
|| Unsigned(Yap_tokptr->TokInfo) != 'l')
|
||||||
&& (opinfo = Yap_GetAProp((Atom) t, OpProperty))
|
&& (opinfo = Yap_GetOpProp((Atom) t))
|
||||||
&& IsPrefixOp(opinfo, &opprio, &oprprio)
|
&& IsPrefixOp(opinfo, &opprio, &oprprio)
|
||||||
) {
|
) {
|
||||||
/* special rules apply for +1, -2.3, etc... */
|
/* 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 */
|
/* main loop to parse infix and posfix operators starts here */
|
||||||
while (TRUE) {
|
while (TRUE) {
|
||||||
if (Yap_tokptr->Tok == Ord(Name_tok)
|
if (Yap_tokptr->Tok == Ord(Name_tok)
|
||||||
&& (opinfo = Yap_GetAProp((Atom)(Yap_tokptr->TokInfo), OpProperty))) {
|
&& (opinfo = Yap_GetOpProp((Atom)(Yap_tokptr->TokInfo)))) {
|
||||||
Prop save_opinfo = opinfo;
|
OpEntry *save_opinfo = opinfo;
|
||||||
if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio)
|
if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio)
|
||||||
&& opprio <= prio && oplprio >= curprio) {
|
&& opprio <= prio && oplprio >= curprio) {
|
||||||
/* try parsing as infix operator */
|
/* try parsing as infix operator */
|
||||||
|
15
C/stdpreds.c
15
C/stdpreds.c
@ -11,8 +11,11 @@
|
|||||||
* File: stdpreds.c *
|
* File: stdpreds.c *
|
||||||
* comments: General-purpose C implemented system predicates *
|
* 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 $
|
* $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
|
* Revision 1.93 2005/08/04 15:45:53 ricroc
|
||||||
* TABLING NEW: support to limit the table space size
|
* TABLING NEW: support to limit the table space size
|
||||||
*
|
*
|
||||||
@ -891,8 +894,12 @@ p_opdec(void)
|
|||||||
{ /* '$opdec'(p,type,atom) */
|
{ /* '$opdec'(p,type,atom) */
|
||||||
/* we know the arguments are integer, atom, atom */
|
/* we know the arguments are integer, atom, atom */
|
||||||
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
|
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
|
||||||
return (Yap_OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE,
|
Term tmod = Deref(ARG4);
|
||||||
AtomOfTerm(at)));
|
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("get_value", 2, p_value, TestPredFlag|SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||||
/* general purpose */
|
/* 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("name", 2, p_name, 0);
|
||||||
Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag);
|
Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag);
|
||||||
Yap_InitCPred("atom_chars", 2, p_atom_chars, 0);
|
Yap_InitCPred("atom_chars", 2, p_atom_chars, 0);
|
||||||
|
@ -184,14 +184,14 @@ legalAtom(char *s) /* Is this a legal atom ? */
|
|||||||
static int LeftOpToProtect(Atom at, int p)
|
static int LeftOpToProtect(Atom at, int p)
|
||||||
{
|
{
|
||||||
int op, rp;
|
int op, rp;
|
||||||
Prop opinfo = Yap_GetAProp(at, OpProperty);
|
OpEntry *opinfo = Yap_GetOpProp(at);
|
||||||
return(opinfo && Yap_IsPrefixOp(opinfo, &op, &rp) );
|
return(opinfo && Yap_IsPrefixOp(opinfo, &op, &rp) );
|
||||||
}
|
}
|
||||||
|
|
||||||
static int RightOpToProtect(Atom at, int p)
|
static int RightOpToProtect(Atom at, int p)
|
||||||
{
|
{
|
||||||
int op, lp;
|
int op, lp;
|
||||||
Prop opinfo = Yap_GetAProp(at, OpProperty);
|
OpEntry *opinfo = Yap_GetOpProp(at);
|
||||||
return(opinfo && Yap_IsPosfixOp(opinfo, &op, &lp) );
|
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);
|
Functor functor = FunctorOfTerm(t);
|
||||||
int Arity;
|
int Arity;
|
||||||
Atom atom;
|
Atom atom;
|
||||||
Prop opinfo;
|
OpEntry *opinfo;
|
||||||
int op, lp, rp;
|
int op, lp, rp;
|
||||||
|
|
||||||
if (IsExtensionFunctor(functor)) {
|
if (IsExtensionFunctor(functor)) {
|
||||||
@ -459,7 +459,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
|
|||||||
}
|
}
|
||||||
Arity = ArityOfFunctor(functor);
|
Arity = ArityOfFunctor(functor);
|
||||||
atom = NameOfFunctor(functor);
|
atom = NameOfFunctor(functor);
|
||||||
opinfo = Yap_GetAProp(atom, OpProperty);
|
opinfo = Yap_GetOpProp(atom);
|
||||||
#ifdef SFUNC
|
#ifdef SFUNC
|
||||||
if (Arity == SFArity) {
|
if (Arity == SFArity) {
|
||||||
int argno = 1;
|
int argno = 1;
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
* File: Yap.proto *
|
* File: Yap.proto *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Function declarations for YAP *
|
* 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 */
|
/* prototype file for Yap */
|
||||||
@ -194,7 +194,7 @@ void STD_PROTO(Yap_KillStacks,(void));
|
|||||||
#endif
|
#endif
|
||||||
void STD_PROTO(Yap_InitYaamRegs,(void));
|
void STD_PROTO(Yap_InitYaamRegs,(void));
|
||||||
void STD_PROTO(Yap_ReInitWallTime, (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 */
|
/* inlines.c */
|
||||||
void STD_PROTO(Yap_InitInlines,(void));
|
void STD_PROTO(Yap_InitInlines,(void));
|
||||||
@ -243,9 +243,6 @@ Term STD_PROTO(Yap_MkNewPairTerm,(void));
|
|||||||
|
|
||||||
|
|
||||||
/* parser.c */
|
/* 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));
|
Term STD_PROTO(Yap_Parse,(void));
|
||||||
|
|
||||||
/* save.c */
|
/* save.c */
|
||||||
|
@ -268,6 +268,7 @@ typedef struct
|
|||||||
#if defined(YAPOR) || defined(THREADS)
|
#if defined(YAPOR) || defined(THREADS)
|
||||||
rwlock_t OpRWLock; /* a read-write lock to protect the entry */
|
rwlock_t OpRWLock; /* a read-write lock to protect the entry */
|
||||||
#endif
|
#endif
|
||||||
|
Term OpModule; /* module of predicate */
|
||||||
BITS16 Prefix, Infix, Posfix; /* precedences */
|
BITS16 Prefix, Infix, Posfix; /* precedences */
|
||||||
} OpEntry;
|
} OpEntry;
|
||||||
#if USE_OFFSETS_IN_PROPS
|
#if USE_OFFSETS_IN_PROPS
|
||||||
@ -280,8 +281,6 @@ RepOpProp (Prop p)
|
|||||||
return (OpEntry *) (AtomBase + Unsigned (p));
|
return (OpEntry *) (AtomBase + Unsigned (p));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
inline EXTERN Prop AbsOpProp (OpEntry * p);
|
inline EXTERN Prop AbsOpProp (OpEntry * p);
|
||||||
|
|
||||||
inline EXTERN Prop
|
inline EXTERN Prop
|
||||||
@ -324,7 +323,11 @@ IsOpProperty (int flags)
|
|||||||
return (PropFlags) ((flags == OpProperty));
|
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 */
|
/* defines related to operator specifications */
|
||||||
#define MaskPrio 0x0fff
|
#define MaskPrio 0x0fff
|
||||||
|
14
H/rheap.h
14
H/rheap.h
@ -11,8 +11,12 @@
|
|||||||
* File: rheap.h *
|
* File: rheap.h *
|
||||||
* comments: walk through heap code *
|
* 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 $
|
* $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
|
* Revision 1.54 2005/09/09 17:24:39 vsc
|
||||||
* a new and hopefully much better implementation of atts.
|
* a new and hopefully much better implementation of atts.
|
||||||
*
|
*
|
||||||
@ -1090,8 +1094,14 @@ RestoreEntries(PropEntry *pp)
|
|||||||
RestoreBB(bb);
|
RestoreBB(bb);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case ExpProperty:
|
|
||||||
case OpProperty:
|
case OpProperty:
|
||||||
|
{
|
||||||
|
OpEntry *opp = (OpEntry *)pp;
|
||||||
|
if (opp->OpModule) {
|
||||||
|
opp->OpModule = AtomTermAdjust(opp->OpModule);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
case ExpProperty:
|
||||||
case ModProperty:
|
case ModProperty:
|
||||||
pp->NextOfPE =
|
pp->NextOfPE =
|
||||||
PropAdjust(pp->NextOfPE);
|
PropAdjust(pp->NextOfPE);
|
||||||
|
@ -229,7 +229,10 @@ print_usage(void)
|
|||||||
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
|
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
|
||||||
fprintf(stderr," -? Shows this screen\n");
|
fprintf(stderr," -? Shows this screen\n");
|
||||||
fprintf(stderr," -b Boot file \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",
|
fprintf(stderr," -h Heap area in Kbytes (default: %d, minimum: %d)\n",
|
||||||
DefHeapSpace, MinHeapSpace);
|
DefHeapSpace, MinHeapSpace);
|
||||||
fprintf(stderr," -s Stack area in Kbytes (default: %d, minimum: %d)\n",
|
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;
|
iap->YapPrologRCFile = *argv;
|
||||||
}
|
}
|
||||||
break;
|
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 */
|
/* nf: Begin preprocessor code */
|
||||||
case 'D':
|
case 'D':
|
||||||
{
|
{
|
||||||
@ -487,6 +518,8 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
|
|||||||
iap->YapPrologBootFile = NULL;
|
iap->YapPrologBootFile = NULL;
|
||||||
iap->YapPrologInitFile = NULL;
|
iap->YapPrologInitFile = NULL;
|
||||||
iap->YapPrologRCFile = NULL;
|
iap->YapPrologRCFile = NULL;
|
||||||
|
iap->YapPrologGoal = NULL;
|
||||||
|
iap->YapPrologTopLevelGoal = NULL;
|
||||||
iap->HaltAfterConsult = FALSE;
|
iap->HaltAfterConsult = FALSE;
|
||||||
iap->FastBoot = FALSE;
|
iap->FastBoot = FALSE;
|
||||||
iap->MaxTableSpaceSize = 0;
|
iap->MaxTableSpaceSize = 0;
|
||||||
|
@ -22,16 +22,16 @@
|
|||||||
functions indirectly
|
functions indirectly
|
||||||
****************************************************/
|
****************************************************/
|
||||||
|
|
||||||
|
#ifndef _yap_c_interface_h
|
||||||
|
|
||||||
|
#define _yap_c_interface_h 1
|
||||||
|
|
||||||
#include "yap_structs.h"
|
#include "yap_structs.h"
|
||||||
|
|
||||||
#if HAVE_STDARG_H
|
#if HAVE_STDARG_H
|
||||||
#include <stdarg.h>
|
#include <stdarg.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifndef _yap_c_interface_h
|
|
||||||
|
|
||||||
#define _yap_c_interface_h 1
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
__BEGIN_DECLS should be used at the beginning of the C declarations,
|
__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
|
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));
|
extern X_API YAP_Bool PROTO(YAP_CallProlog,(YAP_Term t));
|
||||||
|
|
||||||
/* void cut_fail(void) */
|
/* 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) */
|
#define YAP_cut_succeed() { YAP_cut_up(); return TRUE; }
|
||||||
extern X_API void PROTO(YAP_cut_succeed,(void));
|
|
||||||
|
#define YAP_cut_fail() { YAP_cut_up(); return FALSE; }
|
||||||
|
|
||||||
/* void *AllocSpaceFromYAP_(int) */
|
/* void *AllocSpaceFromYAP_(int) */
|
||||||
extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
|
extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
|
||||||
|
@ -83,6 +83,10 @@ typedef struct {
|
|||||||
char *YapPrologInitFile;
|
char *YapPrologInitFile;
|
||||||
/* if NON-NULL, name for a Prolog file to consult before entering top-level */
|
/* if NON-NULL, name for a Prolog file to consult before entering top-level */
|
||||||
char *YapPrologRCFile;
|
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 */
|
/* if previous NON-NULL and TRUE, halt after consulting that file */
|
||||||
int HaltAfterConsult;
|
int HaltAfterConsult;
|
||||||
/* ignore .yaprc, .prolog.ini, etc. files. */
|
/* ignore .yaprc, .prolog.ini, etc. files. */
|
||||||
|
@ -9,6 +9,9 @@
|
|||||||
|
|
||||||
:- use_module(library(lists),[nth/3]).
|
:- use_module(library(lists),[nth/3]).
|
||||||
|
|
||||||
|
:- use_module(library(system),[datime/1,
|
||||||
|
mktime/2]).
|
||||||
|
|
||||||
:- use_module(library(terms),[term_variables/2,
|
:- use_module(library(terms),[term_variables/2,
|
||||||
term_variables/3]).
|
term_variables/3]).
|
||||||
|
|
||||||
@ -161,6 +164,10 @@ prolog:append([],L,L).
|
|||||||
prolog:append([X|L0],L,[X|Lf]) :-
|
prolog:append([X|L0],L,[X|Lf]) :-
|
||||||
prolog:append(L0,L,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).
|
tv(Term,List) :- term_variables(Term,List).
|
||||||
|
|
||||||
prolog:term_variables(Term,List) :- tv(Term,List).
|
prolog:term_variables(Term,List) :- tv(Term,List).
|
||||||
@ -175,3 +182,13 @@ prolog:working_directory(OCWD,NCWD) :-
|
|||||||
|
|
||||||
prolog:chdir(X) :- cd(X).
|
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).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -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: $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: Revision 1.21 2004/08/11 16:14:54 vsc
|
||||||
* mods: whole lot of fixes:
|
* mods: whole lot of fixes:
|
||||||
* mods: - memory leak in indexing
|
* mods: - memory leak in indexing
|
||||||
@ -144,7 +148,7 @@ sysmktime(void)
|
|||||||
return YAP_Unify(YAP_ARG8,YAP_MkIntTerm((long int)((f1-f0)/10000000)));
|
return YAP_Unify(YAP_ARG8,YAP_MkIntTerm((long int)((f1-f0)/10000000)));
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
return FALSE
|
return FALSE;
|
||||||
#endif
|
#endif
|
||||||
#else
|
#else
|
||||||
#ifdef HAVE_MKTIME
|
#ifdef HAVE_MKTIME
|
||||||
@ -208,7 +212,7 @@ datime(void)
|
|||||||
oops
|
oops
|
||||||
#endif /* HAVE_TIME */
|
#endif /* HAVE_TIME */
|
||||||
tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out);
|
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
|
#define BUF_SIZE 1024
|
||||||
|
@ -1320,10 +1320,28 @@ X_API int Sdprintf(char *format,...)
|
|||||||
return 1;
|
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)
|
swi_install(void)
|
||||||
{
|
{
|
||||||
return TRUE;
|
YAP_UserCPredicate("ctime", SWI_ctime, 2);
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
|
@ -12,8 +12,12 @@
|
|||||||
|
|
||||||
|
|
||||||
//=== includes ===============================================================
|
//=== includes ===============================================================
|
||||||
|
#include "config.h"
|
||||||
#include <YapInterface.h>
|
#include <YapInterface.h>
|
||||||
#include <stdarg.h>
|
#include <stdarg.h>
|
||||||
|
#if HAVE_TIME_H
|
||||||
|
#include <time.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
|
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
|
||||||
#define X_API __declspec(dllexport)
|
#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 Sprintf(char *,...);
|
||||||
extern X_API int Sdprintf(char *,...);
|
extern X_API int Sdprintf(char *,...);
|
||||||
|
|
||||||
int swi_install(void);
|
void swi_install(void);
|
||||||
|
|
||||||
|
51
pl/boot.yap
51
pl/boot.yap
@ -96,8 +96,8 @@ true :- true.
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
/* main execution loop */
|
/* main execution loop */
|
||||||
'$read_vars'(Stream,T,Pos,V) :-
|
'$read_vars'(Stream,T,Mod,Pos,V) :-
|
||||||
'$read'(true,T,V,Pos,Err,Stream),
|
'$read'(true,T,Mod,V,Pos,Err,Stream),
|
||||||
(nonvar(Err) ->
|
(nonvar(Err) ->
|
||||||
'$print_message'(error,Err), fail
|
'$print_message'(error,Err), fail
|
||||||
;
|
;
|
||||||
@ -129,11 +129,17 @@ true :- true.
|
|||||||
),
|
),
|
||||||
'$print_message'(informational,prompt(BreakLevel,TraceDebug)),
|
'$print_message'(informational,prompt(BreakLevel,TraceDebug)),
|
||||||
fail.
|
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' :-
|
'$enter_top_level' :-
|
||||||
prompt(_,' ?- '),
|
prompt(_,' ?- '),
|
||||||
prompt(' | '),
|
prompt(' | '),
|
||||||
'$run_toplevel_hooks',
|
'$run_toplevel_hooks',
|
||||||
'$read_vars'(user_input,Command,_,Varnames),
|
'$read_vars'(user_input,Command,_,_,Varnames),
|
||||||
set_value(spy_gn,1),
|
set_value(spy_gn,1),
|
||||||
( recorded('$spy_skip',_,R), erase(R), fail ; true),
|
( recorded('$spy_skip',_,R), erase(R), fail ; true),
|
||||||
( recorded('$spy_stop',_,R), erase(R), fail ; true),
|
( recorded('$spy_stop',_,R), erase(R), fail ; true),
|
||||||
@ -145,9 +151,14 @@ true :- true.
|
|||||||
'$startup_goals' :-
|
'$startup_goals' :-
|
||||||
recorded('$startup_goal',G,_),
|
recorded('$startup_goal',G,_),
|
||||||
'$current_module'(Module),
|
'$current_module'(Module),
|
||||||
'$system_catch'('$query'((G->true), []),Module,Error,user:'$Error'(Error)),
|
'$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)),
|
||||||
fail.
|
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' :-
|
'$startup_reconsult' :-
|
||||||
get_value('$consult_on_boot',X), X \= [], !,
|
get_value('$consult_on_boot',X), X \= [], !,
|
||||||
@ -723,9 +734,10 @@ not(G) :- \+ '$execute'(G).
|
|||||||
% make sure we do not loop on undefined predicates
|
% make sure we do not loop on undefined predicates
|
||||||
% for undefined_predicates.
|
% for undefined_predicates.
|
||||||
'$enter_undefp',
|
'$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),
|
functor(G,F,N),
|
||||||
recorded('$import','$import'(S,M,F,N),_),
|
recorded('$import','$import'(S,M,F,N),_),
|
||||||
S \= M, % can't try importing from the module itself.
|
S \= M, % can't try importing from the module itself.
|
||||||
@ -734,25 +746,22 @@ not(G) :- \+ '$execute'(G).
|
|||||||
(
|
(
|
||||||
'$meta_expansion'(S,M,G,G1,[])
|
'$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),
|
'$is_expand_goal_or_meta_predicate'(G,M),
|
||||||
'$system_catch'(goal_expansion(G, M, NG), user, _, fail), !,
|
'$system_catch'(goal_expansion(G, M, NG), user, _, fail), !,
|
||||||
'$exit_undefp',
|
'$exit_undefp'.
|
||||||
'$execute0'(NG,M).
|
'$find_undefp_handler'(G,M,NG,user) :-
|
||||||
'$do_undefp'(G,M) :-
|
|
||||||
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
|
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
|
||||||
'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)),
|
'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), !,
|
||||||
'$exit_undefp', !,
|
'$exit_undefp'.
|
||||||
'$execute'(user:NG).
|
'$find_undefp_handler'(G,M,US,user) :-
|
||||||
'$do_undefp'(G,M) :-
|
|
||||||
recorded('$unknown','$unknown'(M:G,US),_), !,
|
recorded('$unknown','$unknown'(M:G,US),_), !,
|
||||||
'$exit_undefp',
|
'$exit_undefp'.
|
||||||
'$execute'(user:US).
|
'$find_undefp_handler'(G,M,_,_) :-
|
||||||
'$do_undefp'(_,_) :-
|
|
||||||
'$exit_undefp',
|
'$exit_undefp',
|
||||||
fail.
|
fail.
|
||||||
|
|
||||||
@ -821,7 +830,7 @@ bootstrap(F) :-
|
|||||||
!.
|
!.
|
||||||
|
|
||||||
'$enter_command'(Stream,Status) :-
|
'$enter_command'(Stream,Status) :-
|
||||||
'$read_vars'(Stream,Command,_,Vars),
|
'$read_vars'(Stream,Command,_,_,Vars),
|
||||||
'$command'(Command,Vars,Status).
|
'$command'(Command,Vars,Status).
|
||||||
|
|
||||||
'$abort_loop'(Stream) :-
|
'$abort_loop'(Stream) :-
|
||||||
|
10
pl/debug.yap
10
pl/debug.yap
@ -416,12 +416,20 @@ debugging :-
|
|||||||
'$execute_nonstop'(G, M).
|
'$execute_nonstop'(G, M).
|
||||||
'$spycall'(G, M, InControl) :-
|
'$spycall'(G, M, InControl) :-
|
||||||
'$flags'(G,M,F,F),
|
'$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
|
% use the interpreter
|
||||||
CP is '$last_choice_pt',
|
CP is '$last_choice_pt',
|
||||||
'$clause'(G, M, Cl),
|
'$clause'(G, M, Cl),
|
||||||
'$do_not_creep',
|
'$do_not_creep',
|
||||||
'$do_spy'(Cl, M, CP, InControl).
|
'$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) :-
|
'$spycall'(G, M, InControl) :-
|
||||||
% I lost control here.
|
% I lost control here.
|
||||||
CP is '$last_choice_pt',
|
CP is '$last_choice_pt',
|
||||||
|
@ -85,7 +85,17 @@ module(N) :-
|
|||||||
recorded('$module','$module'(F0,Mod,_),R), !,
|
recorded('$module','$module'(F0,Mod,_),R), !,
|
||||||
'$add_preexisting_module_on_file'(F, F0, Mod, Exports, R).
|
'$add_preexisting_module_on_file'(F, F0, Mod, Exports, R).
|
||||||
'$add_module_on_file'(Mod, F, Exports) :-
|
'$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.
|
% redefining a previously-defined file, no problem.
|
||||||
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !,
|
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !,
|
||||||
|
13
pl/utils.yap
13
pl/utils.yap
@ -176,7 +176,7 @@ op(P,T,V) :- '$op2'(P,T,V).
|
|||||||
|
|
||||||
'$op'(P,T,',') :- !,
|
'$op'(P,T,',') :- !,
|
||||||
'$do_error'(permission_error(modify,operator,','),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
|
%%% Operating System utilities
|
||||||
|
|
||||||
@ -725,3 +725,14 @@ nth_instance(X,Y,Z) :-
|
|||||||
nth_instance(X,Y,Z) :-
|
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
28
pl/yio.yap
@ -147,7 +147,8 @@ open(F,T,S,Opts) :-
|
|||||||
'$check_opt_read'(singletons(_), _) :- !.
|
'$check_opt_read'(singletons(_), _) :- !.
|
||||||
'$check_opt_read'(syntax_errors(T), G) :- !,
|
'$check_opt_read'(syntax_errors(T), G) :- !,
|
||||||
'$check_read_syntax_errors_arg'(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) :-
|
'$check_opt_read'(A, G) :-
|
||||||
'$do_error'(domain_error(read_option,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 */
|
/* Term IO */
|
||||||
|
|
||||||
read(T) :-
|
read(T) :-
|
||||||
'$read'(false,T,_,_,Err),
|
'$read'(false,T,_,_,_,Err),
|
||||||
(nonvar(Err) ->
|
(nonvar(Err) ->
|
||||||
'$print_message'(error,Err), fail
|
'$print_message'(error,Err), fail
|
||||||
;
|
;
|
||||||
@ -324,7 +325,7 @@ read(T) :-
|
|||||||
).
|
).
|
||||||
|
|
||||||
read(Stream,T) :-
|
read(Stream,T) :-
|
||||||
'$read'(false,T,V,_,Err,Stream),
|
'$read'(false,T,_,_,_,Err,Stream),
|
||||||
(nonvar(Err) ->
|
(nonvar(Err) ->
|
||||||
'$print_message'(error,Err), fail
|
'$print_message'(error,Err), fail
|
||||||
;
|
;
|
||||||
@ -334,27 +335,29 @@ read(Stream,T) :-
|
|||||||
read_term(T, Options) :-
|
read_term(T, Options) :-
|
||||||
'$check_io_opts'(Options,read_term(T, Options)),
|
'$check_io_opts'(Options,read_term(T, Options)),
|
||||||
current_input(S),
|
current_input(S),
|
||||||
'$preprocess_read_terms_options'(Options),
|
'$preprocess_read_terms_options'(Options,Module),
|
||||||
'$read_vars'(S,T,Pos,VL),
|
'$read_vars'(S,T,Module,Pos,VL),
|
||||||
'$postprocess_read_terms_options'(Options, T, VL, Pos).
|
'$postprocess_read_terms_options'(Options, T, VL, Pos).
|
||||||
|
|
||||||
read_term(Stream, T, Options) :-
|
read_term(Stream, T, Options) :-
|
||||||
'$check_io_opts'(Options,read_term(T, Options)),
|
'$check_io_opts'(Options,read_term(T, Options)),
|
||||||
'$preprocess_read_terms_options'(Options),
|
'$preprocess_read_terms_options'(Options,Module),
|
||||||
'$read_vars'(Stream,T,Pos,VL),
|
'$read_vars'(Stream,T,Module,Pos,VL),
|
||||||
'$postprocess_read_terms_options'(Options, T, VL, Pos).
|
'$postprocess_read_terms_options'(Options, T, VL, Pos).
|
||||||
|
|
||||||
%
|
%
|
||||||
% support flags to read
|
% support flags to read
|
||||||
%
|
%
|
||||||
'$preprocess_read_terms_options'([]).
|
'$preprocess_read_terms_options'([],_).
|
||||||
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !,
|
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L],Mod) :- !,
|
||||||
'$get_read_error_handler'(OldVal),
|
'$get_read_error_handler'(OldVal),
|
||||||
set_value('$read_term_error_handler', OldVal),
|
set_value('$read_term_error_handler', OldVal),
|
||||||
'$set_read_error_handler'(NewVal),
|
'$set_read_error_handler'(NewVal),
|
||||||
'$preprocess_read_terms_options'(L).
|
'$preprocess_read_terms_options'(L,Mod).
|
||||||
'$preprocess_read_terms_options'([_|L]) :-
|
'$preprocess_read_terms_options'([module(Mod)|L],Mod) :- !,
|
||||||
'$preprocess_read_terms_options'(L).
|
'$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'([], _, _, _).
|
||||||
'$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !,
|
'$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, _, _) :-
|
'$postprocess_read_terms_option'(variables(Val), T, _, _) :-
|
||||||
'$variables_in_term'(T, [], Val).
|
'$variables_in_term'(T, [], Val).
|
||||||
'$postprocess_read_terms_option'(term_position(Pos), _, _, Pos).
|
'$postprocess_read_terms_option'(term_position(Pos), _, _, Pos).
|
||||||
|
'$postprocess_read_terms_option'(module(_), _, _, _).
|
||||||
%'$postprocess_read_terms_option'(cycles(Val), _, _).
|
%'$postprocess_read_terms_option'(cycles(Val), _, _).
|
||||||
|
|
||||||
'$read_term_non_anonymous'([], []).
|
'$read_term_non_anonymous'([], []).
|
||||||
|
Reference in New Issue
Block a user