double Expression::Parse(const string& token, vector<vector<Expression> >& sSheet, deque<double>& terms) {
if (token.length() == 0) {
throw runtime_error("Parsing failed: please trim whitespace");
} else if (IsVal(token)) {
return atof(token.c_str());
} else if (IsRef(token)) {
return Deref(token, sSheet);
} else if (IsOp(token)) {
return Oper(token, terms);
} else {
throw runtime_error("Parsing failed with: " + token);
}
}
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);
}
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 Int read_stream_to_terms(USES_REGS1) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t, hd;
yhandle_t tails, news;
if (sno < 0)
return FALSE;
t = AbsPair(HR);
RESET_VARIABLE(HR);
Yap_InitSlot((CELL)(HR));
tails = Yap_InitSlot((CELL)(HR));
news = Yap_InitSlot((CELL)(HR));
HR++;
while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
RESET_VARIABLE(HR);
RESET_VARIABLE(HR + 1);
hd = (CELL)HR;
Yap_PutInSlot(news, (CELL)(HR + 1));
HR += 2;
while ((hd = Yap_read_term(sno, TermNil, 2)) == 0L)
;
// just ignore failure
CELL *pt = VarOfTerm(Yap_GetFromSlot(tails));
if (Deref(hd) == TermEOfCode) {
*pt = Deref(ARG3);
break;
} else {
CELL *newpt = (CELL *)Yap_GetFromSlot(news);
*pt = AbsPair(newpt - 1);
Yap_PutInSlot(tails, (CELL)newpt);
}
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify(t, ARG2);
}
static Int check_if_valid_new_alias (USES_REGS1)
{
Term tname = Deref(ARG1);
Atom at;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "$add_alias_to_stream");
return (FALSE);
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "$add_alias_to_stream");
return (FALSE);
}
at = AtomOfTerm(tname);
return(Yap_CheckAlias(at) == -1);
}
int
putimage_withalpha(
IMAGE* imgdest, // handle to dest
IMAGE* imgsrc, // handle to source
int nXOriginDest, // x-coord of destination upper-left corner
int nYOriginDest, // y-coord of destination upper-left corner
int nXOriginSrc, // x-coord of source upper-left corner
int nYOriginSrc, // y-coord of source upper-left corner
int nWidthSrc, // width of source rectangle
int nHeightSrc // height of source rectangle
)
{
return Deref(imgsrc).putimage_withalpha(imgdest, nXOriginDest, nYOriginDest,
nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc);
}
int
putimage_transparent(
IMAGE* imgdest, // handle to dest
IMAGE* imgsrc, // handle to source
int nXOriginDest, // x-coord of destination upper-left corner
int nYOriginDest, // y-coord of destination upper-left corner
color_t crTransparent, // color to make transparent
int nXOriginSrc, // x-coord of source upper-left corner
int nYOriginSrc, // y-coord of source upper-left corner
int nWidthSrc, // width of source rectangle
int nHeightSrc // height of source rectangle
)
{
return Deref(imgsrc).putimage_transparent(imgdest, nXOriginDest, nYOriginDest,
crTransparent, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc);
}
/** @pred prompt(- _A_,+ _B_)
Changes YAP input prompt from _A_ to _B_, active on *next* standard input
interaction.
*/
static Int prompt(USES_REGS1) { /* prompt(Old,New) */
Term t = Deref(ARG2);
Atom a;
if (!Yap_unify_constant(ARG1, MkAtomTerm(LOCAL_AtPrompt)))
return (FALSE);
if (IsVarTerm(t) || !IsAtomTerm(t))
return (FALSE);
a = AtomOfTerm(t);
if (strlen(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(LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
LOCAL_AtPrompt = a;
return (TRUE);
}
static Int
p_frequencyty1( USES_REGS1 )
{
// this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes
if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) {
Term t = Deref(ARG1);
// valid value for ARG1 is just 'atom'
if (IsAtomTerm(t)) {
// ARG1 is atom
int i = 0, j = 0;
char *tmp;
// gets string from atom and stores it on 'str'
char *str = (char*)malloc(YAP_AtomNameLength(AtomOfTerm(t))*sizeof(char));
strcpy(str, AtomName(AtomOfTerm(t)));
// Makes upper characters of 'str' (for comparison)
UPPER_ENTRY(str);
// Detectng frequency type according to 'str'
if (strcmp(str, "COUNTER") == 0 || strcmp(str, "COUNT") == 0) {
ExpEnv.config_struc.frequency_type = COUNTER; // setting frequency type to 'counter'
ExpEnv.config_struc.frequency_bound = 1024.0; // if 'counter', frequency bound is '1024.0'
return TRUE;
}
else if (strcmp(str, "TIME") == 0 || strcmp(str, "TIMING") == 0) {
ExpEnv.config_struc.frequency_type = TIME; // setting frequency type to 'time'
ExpEnv.config_struc.frequency_bound = 0.02; // if 'time', frequency bound is '0.02'
return TRUE;
}
else {
// value passed by argument is out of known range
Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
return FALSE;
}
}
else {
// ARG1 is not an atom
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"Frequency type");
return FALSE;
}
}
else {
// current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
static Int p_set_depth_limit_for_next_call( USES_REGS1 )
{
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
d = MkIntTerm(IntegerOfTerm(d)*2);
DEPTH = d;
return(TRUE);
}
static Int
p_frequency_bound( USES_REGS1 )
{
// this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes
if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) {
Term t = Deref(ARG1);
// valid values for ARG1 are 'integer' and 'float'
if (IsIntTerm(t) || IsFloatTerm(t)) {
// ARG1 is integer or float
// getting ARG1 value
Float v;
if (IsIntTerm(t)) v = (Float)IntOfTerm(t);
if (IsFloatTerm(t)) v = FloatOfTerm(t);
// setting 'frequency bound' if 'frequency type' is 'COUNTER'
if (ExpEnv.config_struc.frequency_type == COUNTER) {
if (v < 20.0) {
fprintf(stderr,"%.2f is a very low value for the active frequency type. Reconsider its value...\n", v);
return FALSE;
}
ExpEnv.config_struc.frequency_bound = roundf(v);
return TRUE;
}
// setting 'frequency bound' if 'frequency type' is 'TIME'
else {
if (v <= 0.0 || v > 0.49) {
fprintf(stderr,"%.2f is an invalid or a very high value for the active frequency type. Reconsider its value...\n", v);
return FALSE;
}
ExpEnv.config_struc.frequency_bound = v;
return TRUE;
}
}
else {
// ARG1 is not an 'integer' or 'float'
Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequency_bound/1 (1st arg)");
return FALSE;
}
}
else {
// current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
return FALSE;
}
}
static Int /* mpe_close(+FileName) */
p_close()
{
Term t_str = Deref(ARG1);
char *str;
/* The arg must be bound to an atom. */
if (IsVarTerm(t_str)) {
Yap_Error(INSTANTIATION_ERROR, t_str, "mpe_close");
return (FALSE);
} else if( !IsAtomTerm(t_str) ) {
Yap_Error(TYPE_ERROR_ATOM, t_str, "mpe_close");
return (FALSE);
} else {
str = RepAtom(AtomOfTerm(t_str))->StrOfAE;
}
return (MPE_Finish_log(str) == 0);
}
static Int
p_agc_threshold(void)
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
return Yap_unify(ARG1, MkIntegerTerm(AGcThreshold));
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER,t,"prolog_flag/2 agc_margin");
return FALSE;
} else {
Int i = IntegerOfTerm(t);
if (i<0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t,"prolog_flag/2 agc_margin");
return FALSE;
} else {
AGcThreshold = i;
return TRUE;
}
}
}
void
Yap_PrintPredName( PredEntry *ap )
{
CACHE_REGS
Term tmod = ap->ModuleOfPred;
if (!tmod) tmod = TermProlog;
#if THREADS
Yap_DebugPlWrite(MkIntegerTerm(worker_id));
Yap_DebugPutc(LOCAL_c_error_stream,' ');
#endif
Yap_DebugPutc(LOCAL_c_error_stream,'>');
Yap_DebugPutc(LOCAL_c_error_stream,'\t');
Yap_DebugPlWrite(tmod);
Yap_DebugPutc(LOCAL_c_error_stream,':');
if (ap->ModuleOfPred == IDB_MODULE) {
Term t = Deref(ARG1);
if (IsAtomTerm(t)) {
Yap_DebugPlWrite(t);
} else if (IsIntegerTerm(t)) {
Yap_DebugPlWrite(t);
} else {
Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
} else {
if (ap->ArityOfPE == 0) {
Atom At = (Atom)ap->FunctorOfPred;
Yap_DebugPlWrite(MkAtomTerm(At));
} else {
Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f);
Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(LOCAL_c_error_stream,'/');
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
}
}
Yap_DebugPutc(LOCAL_c_error_stream,'\n');
}
static Int
p_msort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = HR;
Term out;
/* list size */
Int size;
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
if (size < 0)
return(FALSE);
if (size < 2)
return(Yap_unify(ARG1, ARG2));
pt = HR; /* because of possible garbage collection */
/* reserve the necessary space */
HR += size*2;
simple_mergesort(pt, size, M_EVEN);
adjust_vector(pt, size);
out = AbsPair(pt);
return(Yap_unify(out, ARG2));
}
static Int p_set_depth_limit( USES_REGS1 )
{
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
d = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
}
d = MkIntTerm(IntegerOfTerm(d)*2);
YENV[E_DEPTH] = d;
DEPTH = d;
return(TRUE);
}
static Int exists_file(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 {
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;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
#if _MSC_VER
return ss.st_mode & S_IFREG;
#else
return S_ISREG(ss.st_mode);
#endif
#else
return FALSE;
#endif
}
}
static Int
p_binary_op_as_integer(void)
{ /* X is Y */
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
if (IsIntTerm(t)) {
return Yap_unify_constant(ARG2,t);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
return Yap_unify(ARG1,ARG2);
}
return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
}
return(FALSE);
}
static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
bool rc;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
return false;
}
int l = push_text_stack();
const char *buf = Yap_TextTermToText(t PASS_REGS);
if (buf) {
rc = Yap_IsAbsolutePath(buf, true);
} else {
at = AtomOfTerm(t);
#if _WIN32
rc = PathIsRelative(RepAtom(at)->StrOfAE);
#else
rc = RepAtom(at)->StrOfAE[0] == '/';
#endif
}
pop_text_stack(l);
return rc;
}
static Int
p_sort( USES_REGS1 )
{
/* use the heap to build a new list */
CELL *pt = HR;
Term out;
/* list size */
Int size;
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
if (size < 0)
return(FALSE);
if (size < 2)
return(Yap_unify(ARG1, ARG2));
pt = HR; /* because of possible garbage collection */
/* make sure no one writes on our temp data structure */
HR += size*2;
/* reserve the necessary space */
size = compact_mergesort(pt, size, M_EVEN);
/* reajust space */
HR = pt+size*2;
adjust_vector(pt, size);
out = AbsPair(pt);
return(Yap_unify(out, ARG2));
}
static Int p_wake_choice_point( USES_REGS1 ) {
Term term_offset = Deref(ARG1);
if (IsIntegerTerm(term_offset))
wake_frozen_cp(IntegerOfTerm(term_offset));
return (FALSE);
}
/**
*
@pred +X =< +Y
Lesser than or equal to arithmetic expressions
The value of the expression _X_ is less than or equal to the value
of expression _Y_.
*/
static Int a_le(Term t1, Term t2) { /* A <= B */
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
return out <= 0;
}
/**
* @pred file_name_extension( ? BaseFile, ?Extension, ?FullNameO)
*
* Relate a file name with an extension. The extension is the filename's suffix
* and indicates the kind of the file.
*
* The predicate can be used to:
* - Given __FullName__, extract the extension as _Extension_, and the remainder
* as _BaseFile_. - Given _BaseFile_ and _?Extension_ obtain a _FullNameO_.
* ~~~~
* ~~~~
* Notice that:
* + if no suffix is found, file_name_extension/3 generates the empty
* suffu]kx, `''`. + the extension does not include the `,` separator; + the
* suffix may be longer thsn 3 characters + case should not matter in Windows
* and MacOS + paths may not correspond to valid file names.
*
* @return G
*/
static Int file_name_extension(USES_REGS1) {
Term t1;
Term t2;
Term t3 = Deref(ARG3);
int l = push_text_stack();
if (!IsVarTerm(t3)) {
// full path is given.
const char *f = Yap_GetFileName(t3);
const char *ext;
char *base;
bool rc = true;
seq_type_t typ = Yap_TextType(t3);
if (!f) {
pop_text_stack(l);
return false;
}
size_t len_b = strlen(f), lenb_b;
char *candidate = strrchr(f, '.');
char *file = strrchr(f, '/');
if (candidate && candidate > file) {
lenb_b = candidate - f;
ext = candidate + 1;
} else {
lenb_b = len_b;
ext = "";
}
base = Malloc(lenb_b + 1);
memmove(base, f, lenb_b);
base[lenb_b] = '\0';
if (IsVarTerm(t1 = Deref(ARG1))) {
// should always succeed
rc = Yap_unify(t1, Yap_MkTextTerm(base, typ));
} else {
char *f_a = (char *)Yap_GetFileName(t1 PASS_REGS);
#if __APPLE__ || _WIN32
rc = strcasecmp(f_a, base) == 0;
#else
rc = strcmp(f_a, base) == 0;
#endif
}
if (rc) {
if (IsVarTerm(t2 = Deref(ARG2))) {
// should always succeed
rc = Yap_unify(t2, Yap_MkTextTerm(ext, typ));
} else {
char *f_a = (char *)Yap_TextTermToText(t2 PASS_REGS);
if (f_a[0] == '.') {
f_a += 1;
}
#if __APPLE__ || _WIN32
rc = strcasecmp(f_a, ext) == 0;
#else
rc = strcmp(f_a, ext) == 0;
#endif
}
}
pop_text_stack(l);
return rc;
} else {
const char *f;
char *f2;
seq_type_t typ, typ1 = Yap_TextType((t1 = Deref(ARG1))),
typ2 = Yap_TextType((t2 = Deref(ARG2)));
if (typ1 == typ2) {
typ = typ1;
} else if (typ1 == YAP_STRING_ATOM || typ2 == YAP_STRING_ATOM) {
typ = YAP_STRING_ATOM;
} else {
typ = YAP_STRING_STRING;
}
if (!(f = Yap_TextTermToText(t1 PASS_REGS))) {
pop_text_stack(l);
return false;
}
if (!(f2 = (char *)Yap_TextTermToText(t2 PASS_REGS))) {
pop_text_stack(l);
return false;
}
if (f2[0] == '.') {
f2++;
}
size_t lenb_b = strlen(f);
char *o = Realloc((void *)f, lenb_b + strlen(f2) + 2);
o[lenb_b] = '.';
o += lenb_b + 1;
pop_text_stack(l);
return strcpy(o, f2) && (t3 = Yap_MkTextTerm(o, typ)) &&
Yap_unify(t3, ARG3);
}
}
static Int same_file(USES_REGS1) {
char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
char *f2 = RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE;
if (strcmp(f1, f2) == 0)
return TRUE;
#if HAVE_LSTAT
{
int out;
struct stat *b1, *b2;
while ((char *)HR + sizeof(struct stat) * 2 > (char *)(ASP - 1024)) {
if (!Yap_gcl(2 * sizeof(struct stat), 2, ENV, Yap_gcP())) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
}
b1 = (struct stat *)HR;
b2 = b1 + 1;
if (strcmp(f1, "user_input") == 0) {
if (fstat(fileno(GLOBAL_Stream[0].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f1, "user_output") == 0) {
if (fstat(fileno(GLOBAL_Stream[1].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f1, "user_error") == 0) {
if (fstat(fileno(GLOBAL_Stream[2].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (stat(f1, b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
if (strcmp(f2, "user_input") == 0) {
if (fstat(fileno(GLOBAL_Stream[0].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f2, "user_output") == 0) {
if (fstat(fileno(GLOBAL_Stream[1].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f2, "user_error") == 0) {
if (fstat(fileno(GLOBAL_Stream[2].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (stat(f2, b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
out = (b1->st_ino == b2->st_ino
#ifdef __LCC__
&& memcmp((const void *)&(b1->st_dev), (const void *)&(b2->st_dev),
sizeof(buf1.st_dev)) == 0
#else
&& b1->st_dev == b2->st_dev
#endif
);
return out;
}
#else
return (FALSE);
#endif
}
static Int access_file(USES_REGS1) {
Term tname = Deref(ARG1);
Term tmode = Deref(ARG2);
char *ares;
Atom atmode;
if (IsVarTerm(tmode)) {
Yap_Error(INSTANTIATION_ERROR, tmode, "access_file/2");
return FALSE;
} else if (!IsAtomTerm(tmode)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
return FALSE;
}
atmode = AtomOfTerm(tmode);
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access_file/2");
return FALSE;
} else if (!IsAtomTerm(tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
return FALSE;
} else {
if (atmode == AtomNone)
return TRUE;
if (!(ares = RepAtom(AtomOfTerm(tname))->StrOfAE))
return FALSE;
}
VFS_t *vfs;
if ((vfs = vfs_owner(ares))) {
vfs_stat o;
if (vfs->stat(vfs, ares, &o)) {
if (atmode == AtomExist)
return true;
else if (atmode == AtomExists)
return true;
else if (atmode == AtomWrite)
return o.st_mode & VFS_CAN_WRITE;
else if (atmode == AtomRead)
return o.st_mode & VFS_CAN_READ;
else if (atmode == AtomAppend)
return o.st_mode & VFS_CAN_WRITE;
else if (atmode == AtomCsult)
return o.st_mode & VFS_CAN_READ;
else if (atmode == AtomExecute)
return o.st_mode & VFS_CAN_EXEC;
else {
Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
return FALSE;
}
} else {
return false;
}
}
#if HAVE_ACCESS
#if _WIN32
{
int mode;
if (atmode == AtomExist)
mode = 00;
else if (atmode == AtomExists)
mode = 00;
else if (atmode == AtomWrite)
mode = 02;
else if (atmode == AtomRead)
mode = 04;
else if (atmode == AtomAppend)
mode = 03;
else if (atmode == AtomCsult)
mode = 04;
else if (atmode == AtomExecute)
mode = 00; // can always execute?
else {
Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
return FALSE;
}
if (access(ares, mode) < 0) {
/* ignore errors while checking a file */
return false;
}
return true;
}
#else
{
int mode;
if (atmode == AtomExist)
mode = F_OK;
else if (atmode == AtomExists)
mode = F_OK;
else if (atmode == AtomWrite)
mode = W_OK;
else if (atmode == AtomRead)
mode = R_OK;
else if (atmode == AtomAppend)
mode = W_OK;
else if (atmode == AtomCsult)
mode = R_OK;
else if (atmode == AtomExecute)
mode = X_OK;
else {
Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
return FALSE;
}
if (access(ares, mode) < 0) {
/* ignore errors while checking a file */
return false;
}
return true;
}
#endif
#elif HAVE_STAT
{
struct SYSTEM_STAT ss;
if (SYSTEM_STAT(ares, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return TRUE;
}
#else
return FALSE;
#endif
}
static Int time_file(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 {
const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE;
VFS_t *vfs;
if ((vfs = vfs_owner(n))) {
vfs_stat s;
vfs->stat(vfs, n, &s);
return Yap_unify(ARG2, MkIntegerTerm(s.st_mtimespec.tv_sec));
}
#if __WIN32
FILETIME ft;
HANDLE hdl;
Term rc;
if ((hdl = CreateFile(n, 0, 0, NULL, OPEN_EXISTING, 0, 0)) == 0) {
Yap_WinError("in time_file");
return false;
}
if (GetFileTime(hdl, NULL, NULL, &ft) == 0) {
Yap_WinError("in time_file");
return false;
}
// Convert the last-write time to local time.
// FileTimeToSystemTime(&ftWrite, &stUTC);
// SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal);
CloseHandle(hdl);
ULONGLONG qwResult;
// Copy the time into a quadword.
qwResult = (((ULONGLONG)ft.dwHighDateTime) << 32) + ft.dwLowDateTime;
#if SIZEOF_INT_P == 8
rc = MkIntegerTerm(qwResult);
#elif USE_GMP
char s[64];
MP_INT rop;
snprintf(s, 64, "%I64d", (long long int)n);
mpz_init_set_str(&rop, s, 10);
rc = Yap_MkBigIntTerm((void *)&rop PASS_REGS);
#else
rc = MkIntegerTerm(ft.dwHighDateTime);
#endif
return Yap_unify(ARG2, rc);
#elif HAVE_STAT
struct SYSTEM_STAT ss;
if (SYSTEM_STAT(n, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return Yap_unify(ARG2, MkIntegerTerm(ss.st_mtime));
#else
return FALSE;
#endif
}
}
/// @memberof logsum/3
static Int
p_logsum( USES_REGS1 )
{ /* X is Y */
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
int done = FALSE;
Float f1, f2;
while (!done) {
if (IsFloatTerm(t1)) {
f1 = FloatOfTerm(t1);
done = TRUE;
} else if (IsIntegerTerm(t1)) {
f1 = IntegerOfTerm(t1);
done = TRUE;
#if USE_GMP
} else if (IsBigIntTerm(t1)) {
f1 = Yap_gmp_to_float(t1);
done = TRUE;
#endif
} else {
while (!(t1 = Eval(t1 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, LOCAL_Error_Term, LOCAL_ErrorMessage);
return FALSE;
}
}
}
}
done = FALSE;
while (!done) {
if (IsFloatTerm(t2)) {
f2 = FloatOfTerm(t2);
done = TRUE;
} else if (IsIntegerTerm(t2)) {
f2 = IntegerOfTerm(t2);
done = TRUE;
#if USE_GMP
} else if (IsBigIntTerm(t2)) {
f2 = Yap_gmp_to_float(t2);
done = TRUE;
#endif
} else {
while (!(t2 = Eval(t2 PASS_REGS))) {
if (LOCAL_Error_TYPE == 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(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
return FALSE;
}
}
}
}
if (f1 >= f2) {
Float fi = exp(f2-f1);
return Yap_unify(ARG3,MkFloatTerm(f1+log(1+fi)));
} else {
Float fi = exp(f1-f2);
return Yap_unify(ARG3,MkFloatTerm(f2+log(1+fi)));
}
}
static Int p_table( USES_REGS1 ) {
Term mod, t, list;
PredEntry *pe;
Atom at;
int arity;
tab_ent_ptr tab_ent;
#ifdef MODE_DIRECTED_TABLING
int* mode_directed = NULL;
#endif /* MODE_DIRECTED_TABLING */
mod = Deref(ARG1);
t = Deref(ARG2);
list = Deref(ARG3);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
arity = 0;
} else if (IsApplTerm(t)) {
at = NameOfFunctor(FunctorOfTerm(t));
pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod));
arity = ArityOfFunctor(FunctorOfTerm(t));
} else
return (FALSE);
if (list != TermNil) { /* non-empty list */
#ifndef MODE_DIRECTED_TABLING
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity);
return(FALSE);
#else
/*************************************************************************************
The mode operator declaration is reordered as follows:
1. arguments with mode 'index' (any number)
2. arguments with mode 'min' and 'max' (any number, following the original order)
3. arguments with mode 'all' (any number)
4. arguments with mode 'sum' or 'last' (only one of the two is allowed)
5. arguments with mode 'first' (any number)
*************************************************************************************/
int pos_index = 0;
int pos_min_max = 0;
int pos_all = 0;
int pos_sum_last = 0;
int pos_first = 0;
int i;
int *aux_mode_directed;
aux_mode_directed = malloc(arity * sizeof(int));
for (i = 0; i < arity; i++) {
int mode = IntOfTerm(HeadOfTerm(list));
if (mode == MODE_DIRECTED_INDEX)
pos_index++;
else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
pos_min_max++;
else if (mode == MODE_DIRECTED_ALL)
pos_all++;
else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) {
if (pos_sum_last) {
free(aux_mode_directed);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity);
return(FALSE);
} else
pos_sum_last = 1;
}
aux_mode_directed[i] = mode;
list = TailOfTerm(list);
}
pos_first = pos_index + pos_min_max + pos_all + pos_sum_last;
pos_sum_last = pos_index + pos_min_max + pos_all;
pos_all = pos_index + pos_min_max;
pos_min_max = pos_index;
pos_index = 0;
ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
for (i = 0; i < arity; i++) {
int aux_pos = 0;
if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
aux_pos = pos_index++;
else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX)
aux_pos = pos_min_max++;
else if (aux_mode_directed[i] == MODE_DIRECTED_ALL)
aux_pos = pos_all++;
else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST)
aux_pos = pos_sum_last++;
else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
aux_pos = pos_first++;
mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]);
}
free(aux_mode_directed);
#endif /* MODE_DIRECTED_TABLING */
}
/// @memberof between/3
static Int
init_between( USES_REGS1 )
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
if (IsVarTerm(t1)) {
Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
return FALSE;
}
if (IsVarTerm(t2)) {
Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
return FALSE;
}
if (!IsIntegerTerm(t1) &&
!IsBigIntTerm(t1)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t1, "between/3");
return FALSE;
}
if (!IsIntegerTerm(t2) &&
!IsBigIntTerm(t2) &&
t2 != MkAtomTerm(AtomInf) &&
t2 != MkAtomTerm(AtomInfinity)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t2, "between/3");
return FALSE;
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Term t3;
t3 = Deref(ARG3);
if (!IsVarTerm(t3)) {
if (!IsIntegerTerm(t3)) {
if (!IsBigIntTerm(t3)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
cut_fail();
} else {
Int i3 = IntegerOfTerm(t3);
if (i3 >= i1 && i3 <= i2)
cut_succeed();
cut_fail();
}
}
if (i1 > i2) cut_fail();
if (i1 == i2) {
Yap_unify(ARG3, t1);
cut_succeed();
}
} else if (IsIntegerTerm(t1) && IsAtomTerm(t2)) {
Int i1 = IntegerOfTerm(t1);
Term t3;
t3 = Deref(ARG3);
if (!IsVarTerm(t3)) {
if (!IsIntegerTerm(t3)) {
if (!IsBigIntTerm(t3)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
cut_fail();
} else {
Int i3 = IntegerOfTerm(t3);
if (i3 >= i1)
cut_succeed();
cut_fail();
}
}
} else {
Term t3 = Deref(ARG3);
Int cmp;
if (!IsVarTerm(t3)) {
if (!IsIntegerTerm(t3) && !IsBigIntTerm(t3)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
if (Yap_acmp(t3, t1 PASS_REGS) >= 0 && Yap_acmp(t2,t3 PASS_REGS) >= 0 && P != FAILCODE)
cut_succeed();
cut_fail();
}
cmp = Yap_acmp(t1, t2 PASS_REGS);
if (cmp > 0) cut_fail();
if (cmp == 0) {
Yap_unify(ARG3, t1);
cut_succeed();
}
}
EXTRA_CBACK_ARG(3,1) = t1;
EXTRA_CBACK_ARG(3,2) = t2;
return cont_between( PASS_REGS1 );
}
static Int p_abolish_frozen_choice_points_until( USES_REGS1 ) {
Term term_offset = Deref(ARG1);
if (IsIntegerTerm(term_offset))
abolish_frozen_cps_until(IntegerOfTerm(term_offset));
return (TRUE);
}
