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))); } }