static Int exists_directory(USES_REGS1) {
Term tname = Deref(ARG1);
char *file_name;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "exists_directory/1");
return FALSE;
} else if (!IsAtomTerm(tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "exists_directory/1");
return FALSE;
} else {
VFS_t *vfs;
char *s = Yap_VF(RepAtom(AtomOfTerm(tname))->StrOfAE);
if (!s) return false;
if ((vfs = vfs_owner(s))) {
bool rc = true;
return vfs->isdir(vfs, s);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return rc;
}
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = Yap_VF(RepAtom(AtomOfTerm(tname))->StrOfAE);
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return false;
}
return (S_ISDIR(ss.st_mode));
#else
return FALSE;
#endif
}
}
/// @memberof is/2
static Int
p_is( USES_REGS1 )
{ /* X is Y */
Term out;
yap_error_number err;
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
Yap_ClearExs();
do {
out = Yap_InnerEval(Deref(ARG2));
if ((err = Yap_FoundArithError()) == YAP_NO_ERROR)
break;
if (err == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
Yap_EvalError(err, ARG2, "X is Exp");
return FALSE;
}
} while (TRUE);
return Yap_unify_constant(ARG1,out);
}
static Int p_freeze_choice_point( USES_REGS1 ) {
if (IsVarTerm(Deref(ARG1))) {
Int offset = freeze_current_cp();
return Yap_unify(ARG1, MkIntegerTerm(offset));
}
return (FALSE);
}
static Term VarNames(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
if (strcmp(RepAtom(p->VarRep)->StrOfAE, "_") != 0) {
Term t[2];
Term o;
t[0] = MkAtomTerm(p->VarRep);
if (!IsVarTerm(p->VarAdr))
p->VarAdr = MkVarTerm();
t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, VarNames(p->VarRight,
VarNames(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
return VarNames(p->VarRight, VarNames(p->VarLeft, l PASS_REGS) PASS_REGS);
}
} else {
return (l);
}
}
static void
mark_local(void)
{
CELL *pt;
/* Adjusting the local */
pt = LCL0;
/* moving the trail is simple */
while (pt > ASP) {
CELL reg = *--pt;
if (!IsVarTerm(reg)) {
if (IsAtomTerm(reg)
#ifdef TABLING
/* assume we cannot have atoms on first page,
so this must be an arity
*/
&& reg > Yap_page_size
#endif
) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
}
}
}
}
static CELL *
mark_global_cell(CELL *pt)
{
CELL reg = *pt;
if (IsVarTerm(reg)) {
/* skip bitmaps */
switch(reg) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
return pt + 4;
#else
return pt + 3;
#endif
case (CELL)FunctorBigInt:
{
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
return pt + sz;
}
case (CELL)FunctorLongInt:
return pt + 3;
break;
}
} else if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
return pt+1;
}
return pt+1;
}
static Int file_exists(USES_REGS1) {
Term tname = Deref(ARG1);
char *file_name;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access");
return FALSE;
} else if (!IsAtomTerm(tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
return FALSE;
} else {
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
if (errno == ENOENT)
return false;
PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, tname, "error %s",
strerror(errno));
return false;
}
return true;
#else
return FALSE;
#endif
}
}
/// @memberof isnan/1
static Int p_isinf(USES_REGS1) { /* X is Y */
Term out = 0L;
while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE;
}
}
if (IsVarTerm(out)) {
Yap_EvalError(INSTANTIATION_ERROR, out, "isinf/1");
return FALSE;
}
if (!IsFloatTerm(out)) {
Yap_EvalError(TYPE_ERROR_FLOAT, out, "isinf/1");
return FALSE;
}
return isinf(FloatOfTerm(out));
}
/** @pred compare( _C_, _X_, _Y_) is iso
As a result of comparing _X_ and _Y_, _C_ may take one of
the following values:
+
`=` if _X_ and _Y_ are identical;
+
`<` if _X_ precedes _Y_ in the defined order;
+
`>` if _Y_ precedes _X_ in the defined order;
*/
Int p_compare(USES_REGS1) { /* compare(?Op,?T1,?T2) */
Int r = compare(Deref(ARG2), Deref(ARG3));
Atom p;
Term t = Deref(ARG1);
if (r < 0)
p = AtomLT;
else if (r > 0)
p = AtomGT;
else
p = AtomEQ;
if (!IsVarTerm(t)) {
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
if (a == p)
return true;
if (a != AtomLT && a != AtomGT && a != AtomEq)
Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
} else {
Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
}
return false;
}
return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_directory_name/2");
return false;
}
at = AtomOfTerm(t);
const char *c = RepAtom(at)->StrOfAE;
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
// file_base_name in SWI and GNU
const char *s;
char c1[YAP_FILENAME_MAX + 1];
strncpy(c1, c, YAP_FILENAME_MAX);
s = dirname(c1);
#else
char s[YAP_FILENAME_MAX + 1];
Int i = strlen(c);
strncpy(s, c, YAP_FILENAME_MAX);
while (--i) {
if (Yap_dir_separator((int)c[i]))
break;
}
if (i == 0) {
s[0] = '.';
i = 1;
}
s[i] = '\0';
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
static Int qq_open(USES_REGS1) {
PRED_LD
Term t = Deref(ARG1);
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) =
FunctorDQuasiQuotation) {
void *ptr;
char *start;
size_t l int s;
Term t0, t1, t2;
if (IsPointerTerm((t0 = ArgOfTerm(1, t))) &&
IsPointerTerm((t1 = ArgOfTerm(2, t))) &&
IsIntegerTerm((t2 = ArgOfTerm(3, t)))) {
ptr = PointerOfTerm(t0);
start = PointerOfTerm(t1);
len = IntegerOfTerm(t2);
if ((s = Yap_open_buf_read_stream(start, len, ENC_UTF8, MEM_BUF_USER)) <
0)
return false;
return Yap_unify(ARG2, Yap_MkStream(s));
} else {
Yap_Error(TYPE_ERROR_READ_CONTEXT, t);
}
return FALSE;
}
}
static Int access_path(USES_REGS1) {
Term tname = Deref(ARG1);
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access");
return false;
} else if (!IsAtomTerm(tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
return false;
} else {
VFS_t *vfs;
char *s = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (!s) return false;
if ((vfs = vfs_owner(s))) {
vfs_stat st;
bool rc = vfs->stat(vfs, s, &st);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return rc;
}
#if HAVE_STAT
struct SYSTEM_STAT ss;
char *file_name;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return true;
}
return true;
#else
return false;
#endif
}
}
static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
return FALSE;
}
at = AtomOfTerm(t);
const char *c = RepAtom(at)->StrOfAE;
const char *s;
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
// file_base_name in SWI and GNU
char c1[YAP_FILENAME_MAX + 1];
strncpy(c1, c, YAP_FILENAME_MAX);
s = basename(c1);
#else
Int i = strlen(c);
while (i && !Yap_dir_separator((int)c[--i]))
;
if (Yap_dir_separator((int)c[i])) {
i++;
}
s = c + i;
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
static Int
p_cyclic( USES_REGS1 )
{
Term t = Deref(ARG1);
if (IsVarTerm(t))
return(FALSE);
return rational_tree(t);
}
static Int
p_acyclic( USES_REGS1 )
{
Term t = Deref(ARG1);
if (IsVarTerm(t))
return(TRUE);
return !rational_tree(t);
}
static Int file_no(int sno, Term t2 USES_REGS) {
int f = Yap_GetStreamFd(sno);
Term rc = MkIntTerm(f);
if (!IsVarTerm(t2) && !IsIntTerm(t2)) {
return false;
}
return Yap_unify_constant(t2, rc);
}
static Int stream_flags(USES_REGS1) { /* '$stream_flags'(+N,-Flags) */
Term trm;
trm = Deref(ARG1);
if (IsVarTerm(trm) || !IsIntTerm(trm))
return (FALSE);
return (Yap_unify_constant(ARG2,
MkIntTerm(GLOBAL_Stream[IntOfTerm(trm)].status)));
}
static Int
open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */
{
Term t, ti;
int sno;
Int sl = 0, nchars = 0;
char *nbuf;
ti = Deref(ARG1);
while (ti != TermNil) {
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
return (FALSE);
} else if (!IsPairTerm(ti)) {
Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
return (FALSE);
} else {
sl++;
ti = TailOfTerm(ti);
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
}
ti = Deref(ARG1);
while (ti != TermNil) {
Term ts = HeadOfTerm(ti);
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
return (FALSE);
} else if (!IsIntTerm(ts)) {
Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
return (FALSE);
}
nbuf[nchars++] = IntOfTerm(ts);
ti = TailOfTerm(ti);
}
nbuf[nchars] = '\0';
sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE);
t = Yap_MkStream (sno);
return (Yap_unify (ARG2, t));
}
static Term Globalize(Term v USES_REGS) {
if (!IsVarTerm(v = Deref(v))) {
return v;
}
if (VarOfTerm(v) > HR && VarOfTerm(v) < LCL0) {
Bind_Local(VarOfTerm(v), MkVarTerm());
v = Deref(v);
}
return v;
}
static Int
p_log() /* mpe_log(+EventType, +EventNum, +EventStr) */
{
Term t_type = Deref(ARG1), t_num = Deref(ARG2), t_str = Deref(ARG3);
Int event_id, event;
char *descr;
/* The first arg must be bount to integer event type ID. */
if (IsVarTerm(t_type)) {
Yap_Error(INSTANTIATION_ERROR, t_type, "mpe_log");
return (FALSE);
} else if( !IsIntegerTerm(t_type) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_type, "mpe_log");
return (FALSE);
} else {
event_id = IntOfTerm(t_type);
}
/* The second arg must be bount to integer event number. */
if (IsVarTerm(t_num)) {
Yap_Error(INSTANTIATION_ERROR, t_num, "mpe_log");
return (FALSE);
} else if( !IsIntegerTerm(t_num) ) {
Yap_Error(TYPE_ERROR_INTEGER, t_num, "mpe_log");
return (FALSE);
} else {
event = IntOfTerm(t_num);
}
/* The third arg must be bound to an atom. */
if (IsVarTerm(t_str)) {
Yap_Error(INSTANTIATION_ERROR, t_str, "mpe_log");
return (FALSE);
} else if( !IsAtomTerm(t_str) ) {
Yap_Error(TYPE_ERROR_ATOM, t_str, "mpe_log");
return (FALSE);
} else {
descr = RepAtom(AtomOfTerm(t_str))->StrOfAE;
}
return ( MPE_Log_event((int)event_id, (int)event, descr) == 0 );
}
static bool
stream_type(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags = GLOBAL_Stream[sno].status & (Binary_Stream_f);
if (!IsVarTerm(t2) && !(isatom(t2))) {
return FALSE;
}
if (flags & Binary_Stream_f)
return Yap_unify(t2, TermBinary);
return Yap_unify(t2, TermText);
}
static Int has_close_on_abort(
int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & DoNotCloseOnAbort_Stream_f;
if (!IsVarTerm(t2)) {
return t2 == (rc ? TermTrue : TermFalse);
}
if (rc) {
return Yap_unify_constant(t2, TermTrue);
} else {
return Yap_unify_constant(t2, TermFalse);
}
}
static Int
has_bom(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f;
if (!IsVarTerm(t2) && !boolean(t2)) {
return FALSE;
}
if (rc) {
return Yap_unify_constant(t2, TermTrue);
} else {
return Yap_unify_constant(t2, TermFalse);
}
}
/** @pred get_value(+ _A_,- _V_)
In YAP, atoms can be associated with constants. If one such
association exists for atom _A_, unify the second argument with the
constant. Otherwise, unify _V_ with `[]`.
This predicate is YAP specific.
*/
static Int p_value(USES_REGS1) { /* '$get_value'(+Atom,?Val) */
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "get_value/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "get_value/2");
return (FALSE);
}
return (Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1))));
}
static Int
has_bom(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & HAS_BOM_f;
if (!IsVarTerm(t2) && !booleanFlag(t2)) {
// Yap_Error( DOMAIN_ERROR_BOOLEAN, t2, " stream_property/2");
return false;
}
if (rc) {
return Yap_unify_constant(t2, TermTrue);
} else {
return Yap_unify_constant(t2, TermFalse);
}
}
static Int p_values(USES_REGS1) { /* '$values'(Atom,Old,New) */
Term t1 = Deref(ARG1), t3 = Deref(ARG3);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "set_value/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "set_value/2");
return (FALSE);
}
if (!Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1)))) {
return (FALSE);
}
if (!IsVarTerm(t3)) {
if (IsAtomTerm(t3) || IsNumTerm(t3)) {
Yap_PutValue(AtomOfTerm(t1), t3);
} else
return (FALSE);
}
return (TRUE);
}
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
Term t0 = t;
ap = nullptr;
restart:
if (IsVarTerm(t)) {
throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
} else if (IsAtomTerm(t)) {
ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
ts = nullptr;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
ts = nullptr;
ap = Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
Yap_TermToIndicator(t, tmod), pname);
}
if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
}
if (!IsAtomTerm(tmod)) {
throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname);
}
t = ArgOfTerm(2, t);
goto restart;
}
ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
ts = RepAppl(t) + 1;
} else {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname);
}
}
static Int prompt1(USES_REGS1) { /* prompt1(Atom) */
Term t = Deref(ARG1);
Atom a;
if (IsVarTerm(t) || !IsAtomTerm(t))
return (FALSE);
LOCAL_AtPrompt = a = AtomOfTerm(t);
if (strlen((char *)RepAtom(a)->StrOfAE) > MAX_PROMPT) {
Yap_Error(SYSTEM_ERROR_INTERNAL, t, "prompt %s is too long",
RepAtom(a)->StrOfAE);
return (FALSE);
}
strncpy(LOCAL_Prompt, (char *)RepAtom(a)->StrOfAE, MAX_PROMPT);
return (TRUE);
}
static bool
found_eof(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags =
GLOBAL_Stream[sno].status & (Past_Eof_Stream_f | Eof_Stream_f);
if (!IsVarTerm(t2) && !(isatom(t2))) {
return FALSE;
}
if (flags & Past_Eof_Stream_f)
return Yap_unify(t2, MkAtomTerm(AtomPast));
if (flags & Eof_Stream_f)
return Yap_unify(t2, MkAtomTerm(AtomAt));
return Yap_unify(t2, MkAtomTerm(AtomNot));
}
static bool
has_encoding(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
if (!IsVarTerm(t2) && !(isatom(t2))) {
return FALSE;
}
if (0 && IsAtomTerm(t2)) {
encoding_t e = enc_id(RepAtom(AtomOfTerm(t2))->StrOfAE);
GLOBAL_Stream[sno].encoding = e;
return true;
} else {
const char *s = enc_name(LOCAL_encoding);
return Yap_unify(t2, MkAtomTerm(Yap_LookupAtom(s)));
}
}
